home *** CD-ROM | disk | FTP | other *** search
/ Ham Radio 2000 #1 / Ham Radio 2000.iso / ham2000 / misc / dspice0s / disto.c < prev    next >
Encoding:
C/C++ Source or Header  |  1992-11-22  |  68.2 KB  |  1,876 lines
  1. /* disto.f -- translated by f2c (version of 3 February 1990  3:36:42).
  2.    You must link the resulting object file with the libraries:
  3.     -lF77 -lI77 -lm -lc   (in that order)
  4. */
  5.  
  6. #include "f2c.h"
  7.  
  8. /* Common Block Declarations */
  9.  
  10. struct {
  11.     integer ielmnt, isbckt, nsbckt, iunsat, nunsat, itemps, numtem, isens, 
  12.         nsens, ifour, nfour, ifield, icode, idelim, icolum, insize, 
  13.         junode, lsbkpt, numbkp, iorder, jmnode, iur, iuc, ilc, ilr, 
  14.         numoff, isr, nmoffc, iseq, iseq1, neqn, nodevs, ndiag, iswap, 
  15.         iequa, macins, lvnim1, lx0, lvn, lynl, lyu, lyl, lx1, lx2, lx3, 
  16.         lx4, lx5, lx6, lx7, ld0, ld1, ltd, imynl, imvn, lcvn, nsnod, 
  17.         nsmat, nsval, icnod, icmat, icval, loutpt, lpol, lzer, irswpf, 
  18.         irswpr, icswpf, icswpr, irpt, jcpt, irowno, jcolno, nttbr, nttar, 
  19.         lvntmp;
  20. } tabinf_;
  21.  
  22. #define tabinf_1 tabinf_
  23.  
  24. struct {
  25.     doublereal atime, aprog[3], adate, atitle[10], defl, defw, defad, defas, 
  26.         rstats[50];
  27.     integer iwidth, lwidth, nopage;
  28. } miscel_;
  29.  
  30. #define miscel_1 miscel_
  31.  
  32. struct {
  33.     integer locate[50], jelcnt[50], nunods, ncnods, numnod, nstop, nut, nlt, 
  34.         nxtrm, ndist, ntlin, ibr, numvs, numalt, numcyc;
  35. } cirdat_;
  36.  
  37. #define cirdat_1 cirdat_
  38.  
  39. struct {
  40.     doublereal omega, time, delta, delold[7], ag[7], vt, xni, egfet, xmu, 
  41.         sfactr;
  42.     integer mode, modedc, icalc, initf, method, iord, maxord, noncon, iterno, 
  43.         itemno, nosolv, modac, ipiv, ivmflg, ipostp, iscrch, iofile;
  44. } status_;
  45.  
  46. #define status_1 status_
  47.  
  48. struct {
  49.     doublereal twopi, xlog2, xlog10, root2, rad, boltz, charge, ctok, gmin, 
  50.         reltol, abstol, vntol, trtol, chgtol, eps0, epssil, epsox, pivtol,
  51.          pivrel;
  52. } knstnt_;
  53.  
  54. #define knstnt_1 knstnt_
  55.  
  56. struct {
  57.     integer iprnta, iprntl, iprntm, iprntn, iprnto, limtim, limpts, lvlcod, 
  58.         lvltim, itl1, itl2, itl3, itl4, itl5, itl6, igoof, nogo, keof;
  59. } flags_;
  60.  
  61. #define flags_1 flags_
  62.  
  63. struct {
  64.     doublereal fstart, fstop, fincr, skw2, refprl, spw2;
  65.     integer jacflg, idfreq, inoise, nosprt, nosout, nosin, idist, idprt;
  66. } ac_;
  67.  
  68. #define ac_1 ac_
  69.  
  70. struct {
  71.     doublereal value[200000];
  72. } blank_;
  73.  
  74. #define blank_1 blank_
  75.  
  76. /* Table of constant values */
  77.  
  78. static integer c__0 = 0;
  79. static integer c__1 = 1;
  80.  
  81. /*<       subroutine disto(loco) >*/
  82. /* Subroutine */ int disto_(loco)
  83. integer *loco;
  84. {
  85.     /* Initialized data */
  86.  
  87.     static struct {
  88.     char e_1[32];
  89.     doublereal e_2;
  90.     } equiv_142 = { {'d', 'i', 's', 't', 'o', 'r', 't', 'i', 'o', 'n', ' '
  91.         , 'a', 'n', 'a', 'l', 'y', 's', 'i', 's', ' ', ' ', ' ', ' ', 
  92.         ' ', ' ', ' ', ' ', ' ', ' ', ' ', ' ', ' '}, 0. };
  93.  
  94. #define distit ((doublereal *)&equiv_142)
  95.  
  96.  
  97.     /* Format strings */
  98.     static char fmt_111[] = "(///5x,\0022nd harmonic distortion\002,30x,\002\
  99. freq1 = \002,1pd9.2,\002  hz\002//5x,\002distortion frequency  \002,d9.2,\
  100. \002  hz\002,16x,\002mag \002,d9.3,3x,\002phs \002,0pf7.2)";
  101.     static char fmt_121[] = "(\0021\002,4x,\0023rd harmonic distortion\002,3\
  102. 0x,\002freq1 = \002,1pd9.2,\002  hz\002//5x,\002distortion frequency  \002,d\
  103. 9.2,\002  hz\002,16x,\002mag \002,d9.3,3x,\002phs \002,0pf7.2)";
  104.     static char fmt_151[] = "(\0021\002,4x,\0022nd order intermodulation dif\
  105. ference component\002,7x,\002freq1 = \002,1pd9.2,\002  hz\002,15x,\002freq2 \
  106. = \002,d9.2,\002  hz\002//5x,\002distortion frequency  \002,d9.2,\002  hz\
  107. \002,16x,\002mag \002,d9.3,3x,\002phs \002,0pf7.2,9x,\002mag \002,1pd9.3,3x\
  108. ,\002phs \002,0pf7.2)";
  109.     static char fmt_161[] = "(\0021\002,4x,\0022nd order intermodulation sum\
  110.  component\002,14x,\002freq1 = \002,1pd9.2,\002  hz\002,15x,\002freq2 = \002\
  111. ,d9.2,\002  hz\002//5x,\002distortion frequency  \002,d9.2,\002  hz\002,16x\
  112. ,\002mag \002,d9.3,3x,\002phs \002,0pf7.2,9x,\002mag \002,1pd9.3,3x,\002phs\
  113.  \002,0pf7.2)";
  114.     static char fmt_171[] = "(\0021\002,4x,\0023rd order intermodulation dif\
  115. ference component\002,7x,\002freq1 = \002,1pd9.2,\002  hz\002,15x,\002freq2 \
  116. = \002,d9.2,\002  hz\002//5x,\002distortion frequency  \002,d9.2,\002  hz\
  117. \002,16x,\002mag \002,d9.3,3x,\002phs \002,0pf7.2,9x,\002mag \002,1pd9.3,3x\
  118. ,\002phs \002,0pf7.2)";
  119.     static char fmt_211[] = "(\0020warning:  underflow \002,i4,\002 time(s) \
  120. in distortion analysis at freq = \002,1pd9.3,\002 hz\002)";
  121.     static char fmt_301[] = "(////1x,\002bjt distortion components\002//1x\
  122. ,\002name\002,11x,\002gm\002,8x,\002gpi\002,7x,\002go\002,8x,\002gmu\002,6x\
  123. ,\002gmo2\002,7x,\002cb\002,8x,\002cbr\002,7x,\002cje\002,7x,\002cjc\002,6x\
  124. ,\002total\002)";
  125.     static char fmt_311[] = "(////1x,\002bjt distortion components\002//1x\
  126. ,\002name\002,11x,\002gm\002,8x,\002gpi\002,7x,\002go\002,8x,\002gmu\002,6x\
  127. ,\002gmo2\002,7x,\002cb\002,8x,\002cbr\002,7x,\002cje\002,7x,\002cjc\002,6x\
  128. ,\002gm203\002,5x,\002gmo23\002,5x,\002total\002)";
  129.     static char fmt_446[] = "(\0020\002,a8,\002mag\002,1p12d10.3)";
  130.     static char fmt_447[] = "(9x,\002phs\002,12(1x,f7.2,2x))";
  131.     static char fmt_501[] = "(////1x,\002diode distortion components\002//1x\
  132. ,\002name\002,11x,\002geq\002,7x,\002cb\002,8x,\002cj\002,7x,\002total\002)";
  133.     static char fmt_781[] = "(///5x,\002hd2     magnitude  \002,1pd10.3,5x\
  134. ,\002phase  \002,0pf7.2,5x,\002=  \002,f7.2,\002  db\002)";
  135.     static char fmt_791[] = "(///5x,\002hd3     magnitude  \002,1pd10.3,5x\
  136. ,\002phase  \002,0pf7.2,5x,\002=  \002,f7.2,\002  db\002)";
  137.     static char fmt_841[] = "(///5x,\002im2d    magnitude  \002,1pd10.3,5x\
  138. ,\002phase  \002,0pf7.2,5x,\002=  \002,f7.2,\002  db\002)";
  139.     static char fmt_851[] = "(///5x,\002im2s    magnitude  \002,1pd10.3,5x\
  140. ,\002phase  \002,0pf7.2,5x,\002=  \002,f7.2,\002  db\002)";
  141.     static char fmt_861[] = "(///5x,\002im3     magnitude  \002,1pd10.3,5x\
  142. ,\002phase  \002,0pf7.2,5x,\002=  \002,f7.2,\002  db\002)";
  143.     static char fmt_866[] = "(////5x,\002approximate cross modulation compon\
  144. ents\002)";
  145.     static char fmt_871[] = "(/5x,\002cma     magnitude  \002,1pd10.3,24x\
  146. ,\002=  \002,0pf7.2,\002  db\002)";
  147.     static char fmt_881[] = "(/5x,\002cmp     magnitude  \002,1pd10.3,24x\
  148. ,\002=  \002,0pf7.2,\002  db\002)";
  149.  
  150.     /* System generated locals */
  151.     integer i_1, i_2;
  152.     doublereal d_1, d_2, d_3;
  153.     complex q_1, q_2, q_3, q_4, q_5, q_6, q_7, q_8, q_9, q_10;
  154.     doublecomplex z_1, z_2, z_3, z_4, z_5, z_6, z_7, z_8;
  155.     static complex equiv_1[12];
  156.  
  157.     /* Builtin functions */
  158.     double sqrt();
  159.     integer s_wsfe(), do_fio(), e_wsfe();
  160.     void r_cnjg();
  161.     double r_imag(), d_lg10(), cos(), sin();
  162.  
  163.     /* Local variables */
  164.     static complex bcw12, bew12, cew12;
  165.     static integer locd;
  166.     static doublereal omag;
  167.     static integer idnn;
  168.     static doublereal gmo23;
  169. #define cvdo (equiv_1)
  170.     static integer idnp, locv, loct;
  171.     static doublereal gm2o3, xmag;
  172.     static integer kntr;
  173.     static doublereal xphs;
  174.     static integer locm;
  175.     static complex dscb1;
  176.     static doublereal o2mag;
  177.     static integer node1, node2, node3;
  178.     static doublereal o3mag;
  179.     static complex dsgm2, dsgo2;
  180.     static doublereal freq1, freq2, o2log, o3log;
  181.     static integer icvw1, icvw2;
  182.     static doublereal o2phs, o3phs;
  183.     extern /* Subroutine */ int zero8_();
  184.     static integer j;
  185.     static complex cvabc, cvabe, cvace, dgm2o3, dgmo23;
  186.     static doublereal rload, freqd;
  187.     extern /* Subroutine */ int acsol_();
  188.     static integer icv2w1, icvw12;
  189.     static doublereal o12mag, o12phs;
  190.     static complex dscje1, dscjc1, dscdb1, dscdj1, dscb1r, cvout;
  191.     static integer iprnt;
  192.     extern /* Subroutine */ int title_();
  193.     static complex difvi1, difvi2, difvi3;
  194.     extern /* Subroutine */ int copy16_();
  195.     static complex difvn1, difvn2, difvn3, dsgpi2, dsgmo2;
  196.     static doublereal ow2mag, o12log, o21mag, o21phs;
  197.     static complex dsgmu2;
  198.     static doublereal o21log;
  199.     static complex disto1, disto2, disto3;
  200.     static integer iflag;
  201.     static doublereal ow2phs;
  202.     extern /* Subroutine */ int acload_(), acdcmp_();
  203.     static integer icvadj;
  204.     extern /* Subroutine */ int acasol_();
  205.     static doublereal cmalog;
  206. #define nodplc ((integer *)&blank_1)
  207. #define cvalue ((complex *)&blank_1)
  208.     static complex bcw, bew, cew, cvdist;
  209.     extern /* Subroutine */ int magphs_();
  210.     static doublereal ophase;
  211.     static integer kdisto;
  212.     static doublereal arg;
  213. #define vdo ((real *)equiv_1)
  214.     static integer ititle, loc;
  215.     static doublereal go2, gm2, cb1, go3, gm3, cb2, cma, cdb1, cdb2, cmp, 
  216.         cmplog, cjc1, cjc2, cje1, cje2, cdj1, cdj2, cb1r, cb2r;
  217.     static complex bc2w, bcw2, be2w, ce2w, bew2, cew2, dsg2;
  218.     static doublereal gmo2, gpi2, gpi3, geq2, gmu2, gmu3, geq3;
  219.  
  220.     /* Fortran I/O blocks */
  221.     static cilist io__26 = { 0, 0, 0, fmt_111, 0 };
  222.     static cilist io__27 = { 0, 0, 0, fmt_121, 0 };
  223.     static cilist io__28 = { 0, 0, 0, fmt_151, 0 };
  224.     static cilist io__31 = { 0, 0, 0, fmt_161, 0 };
  225.     static cilist io__32 = { 0, 0, 0, fmt_171, 0 };
  226.     static cilist io__33 = { 0, 0, 0, fmt_211, 0 };
  227.     static cilist io__96 = { 0, 0, 0, fmt_301, 0 };
  228.     static cilist io__97 = { 0, 0, 0, fmt_446, 0 };
  229.     static cilist io__98 = { 0, 0, 0, fmt_447, 0 };
  230.     static cilist io__101 = { 0, 0, 0, fmt_311, 0 };
  231.     static cilist io__102 = { 0, 0, 0, fmt_446, 0 };
  232.     static cilist io__103 = { 0, 0, 0, fmt_447, 0 };
  233.     static cilist io__114 = { 0, 0, 0, fmt_501, 0 };
  234.     static cilist io__115 = { 0, 0, 0, fmt_446, 0 };
  235.     static cilist io__116 = { 0, 0, 0, fmt_447, 0 };
  236.     static cilist io__120 = { 0, 0, 0, fmt_781, 0 };
  237.     static cilist io__124 = { 0, 0, 0, fmt_791, 0 };
  238.     static cilist io__128 = { 0, 0, 0, fmt_841, 0 };
  239.     static cilist io__129 = { 0, 0, 0, fmt_851, 0 };
  240.     static cilist io__133 = { 0, 0, 0, fmt_861, 0 };
  241.     static cilist io__138 = { 0, 0, 0, fmt_866, 0 };
  242.     static cilist io__139 = { 0, 0, 0, fmt_871, 0 };
  243.     static cilist io__140 = { 0, 0, 0, fmt_881, 0 };
  244.  
  245.  
  246. /*<       implicit double precision (a-h,o-z) >*/
  247.  
  248. /*     this routine performs the small-signal distortion analysis. */
  249.  
  250. /* spice version 2g.6  sccsid=tabinf 3/15/83 */
  251. /*<       common /tabinf/ ielmnt,isbckt,nsbckt,iunsat,nunsat,itemps,numtem, >*/
  252. /*<      1   isens,nsens,ifour,nfour,ifield,icode,idelim,icolum,insize, >*/
  253. /*<      2   junode,lsbkpt,numbkp,iorder,jmnode,iur,iuc,ilc,ilr,numoff,isr, >*/
  254. /*<      3   nmoffc,iseq,iseq1,neqn,nodevs,ndiag,iswap,iequa,macins,lvnim1, >*/
  255. /*<      4   lx0,lvn,lynl,lyu,lyl,lx1,lx2,lx3,lx4,lx5,lx6,lx7,ld0,ld1,ltd, >*/
  256. /*<      5   imynl,imvn,lcvn,nsnod,nsmat,nsval,icnod,icmat,icval, >*/
  257. /*<      6   loutpt,lpol,lzer,irswpf,irswpr,icswpf,icswpr,irpt,jcpt, >*/
  258. /*<      7   irowno,jcolno,nttbr,nttar,lvntmp >*/
  259. /* spice version 2g.6  sccsid=miscel 3/15/83 */
  260. /*<       common /miscel/ atime,aprog(3),adate,atitle(10),defl,defw,defad, >*/
  261. /*<      1  defas,rstats(50),iwidth,lwidth,nopage >*/
  262. /* spice version 2g.6  sccsid=cirdat 3/15/83 */
  263. /*<       common /cirdat/ locate(50),jelcnt(50),nunods,ncnods,numnod,nstop, >*/
  264. /*<      1   nut,nlt,nxtrm,ndist,ntlin,ibr,numvs,numalt,numcyc >*/
  265. /* spice version 2g.6  sccsid=status 3/15/83 */
  266. /*<       common /status/ omega,time,delta,delold(7),ag(7),vt,xni,egfet, >*/
  267. /*<      1   xmu,sfactr,mode,modedc,icalc,initf,method,iord,maxord,noncon, >*/
  268. /*<      2   iterno,itemno,nosolv,modac,ipiv,ivmflg,ipostp,iscrch,iofile >*/
  269. /* spice version 2g.6  sccsid=knstnt 3/15/83 */
  270. /*<       common /knstnt/ twopi,xlog2,xlog10,root2,rad,boltz,charge,ctok, >*/
  271. /*<      1   gmin,reltol,abstol,vntol,trtol,chgtol,eps0,epssil,epsox, >*/
  272. /*<      2   pivtol,pivrel >*/
  273. /* spice version 2g.6  sccsid=flags 3/15/83 */
  274. /*<       common /flags/ iprnta,iprntl,iprntm,iprntn,iprnto,limtim,limpts, >*/
  275. /*<      1   lvlcod,lvltim,itl1,itl2,itl3,itl4,itl5,itl6,igoof,nogo,keof >*/
  276. /* spice version 2g.6  sccsid=ac 3/15/83 */
  277. /*<       common /ac/ fstart,fstop,fincr,skw2,refprl,spw2,jacflg,idfreq, >*/
  278. /*<      1   inoise,nosprt,nosout,nosin,idist,idprt >*/
  279. /* spice version 2g.6  sccsid=blank 3/15/83 */
  280. /*<       common /blank/ value(200000) >*/
  281. /*<       integer nodplc(64) >*/
  282. /*<       complex cvalue(32) >*/
  283. /*<       equivalence (value(1),nodplc(1),cvalue(1)) >*/
  284.  
  285.  
  286. /*<       complex difvn1,difvn2,difvn3,difvi1,difvi2,difvi3,dsgo2,dsgm2, >*/
  287. /*<      1   dsgmu2,dsgpi2,dscb1,dscb1r,dscje1,dscjc1,disto1,disto2,disto3, >*/
  288. /*<      2   dsgmo2,dgm2o3,dgmo23,bew,cew,bcw,be2w,ce2w,bc2w,bew2,cew2, >*/
  289. /*<      3   bcw2,bew12,cew12,bcw12,dscdb1,dscdj1,dsg2,cvabe,cvabc,cvace, >*/
  290. /*<      4   cvout,cvdist >*/
  291. /*<       dimension distit(4) >*/
  292. /*<       dimension vdo(2,12) >*/
  293. /*<       complex cvdo(12) >*/
  294. /*<       real vdo >*/
  295. /*<       equivalence (cvdo(1),vdo(1,1)) >*/
  296. /*<       data distit / 8hdistorti, 8hon analy, 8hsis     , 8h        / >*/
  297.  
  298.  
  299. /*<       icvw1=ld1 >*/
  300.     icvw1 = tabinf_1.ld1;
  301. /*<       icv2w1=icvw1+nstop >*/
  302.     icv2w1 = icvw1 + cirdat_1.nstop;
  303. /*<       icvw2=icv2w1+nstop >*/
  304.     icvw2 = icv2w1 + cirdat_1.nstop;
  305. /*<       icvw12=icvw2+nstop >*/
  306.     icvw12 = icvw2 + cirdat_1.nstop;
  307. /*<       icvadj=icvw12+nstop >*/
  308.     icvadj = icvw12 + cirdat_1.nstop;
  309. /*<       iprnt=0 >*/
  310.     iprnt = 0;
  311. /*<       if (icalc.ge.2) go to 10 >*/
  312.     if (status_1.icalc >= 2) {
  313.     goto L10;
  314.     }
  315. /*<       idnp=nodplc(idist+2) >*/
  316.     idnp = nodplc[ac_1.idist + 1];
  317. /*<       idnn=nodplc(idist+3) >*/
  318.     idnn = nodplc[ac_1.idist + 2];
  319. /*<       locv=nodplc(idist+1) >*/
  320.     locv = nodplc[ac_1.idist];
  321. /*<       rload=1.0d0/value(locv+1) >*/
  322.     rload = 1. / blank_1.value[locv];
  323. /*<       kntr=1 >*/
  324.     kntr = 1;
  325. /*<    10 if (idprt.eq.0) go to 30 >*/
  326. L10:
  327.     if (ac_1.idprt == 0) {
  328.     goto L30;
  329.     }
  330. /*<       if (kntr.gt.icalc) go to 30 >*/
  331.     if (kntr > status_1.icalc) {
  332.     goto L30;
  333.     }
  334. /*<       iprnt=1 >*/
  335.     iprnt = 1;
  336. /*<       kntr=kntr+idprt >*/
  337.     kntr += ac_1.idprt;
  338. /*<       call title(0,lwidth,1,distit) >*/
  339.     title_(&c__0, &miscel_1.lwidth, &c__1, distit);
  340. /*<    30 freq1=dble(real(cvalue(loco+1))) >*/
  341. L30:
  342.     i_1 = *loco;
  343.     freq1 = (doublereal) cvalue[i_1].r;
  344. /*<       freq2=skw2*freq1 >*/
  345.     freq2 = ac_1.skw2 * freq1;
  346. /*<       call copy16(cvalue(lcvn+1),cvalue(icvw1+1),nstop) >*/
  347.     copy16_(&cvalue[tabinf_1.lcvn], &cvalue[icvw1], &cirdat_1.nstop);
  348. /*<       cvout=cvalue(icvw1+idnp)-cvalue(icvw1+idnn) >*/
  349.     i_1 = icvw1 + idnp - 1;
  350.     i_2 = icvw1 + idnn - 1;
  351.     q_1.r = cvalue[i_1].r - cvalue[i_2].r, q_1.i = cvalue[i_1].i - cvalue[i_2]
  352.         .i;
  353.     cvout.r = q_1.r, cvout.i = q_1.i;
  354. /*<       call magphs(cvout,omag,ophase) >*/
  355.     magphs_(&cvout, &omag, &ophase);
  356.  
  357. /*  begin the distortion analysis */
  358.  
  359. /*<       do 1000 kdisto=1,7 >*/
  360.     for (kdisto = 1; kdisto <= 7; ++kdisto) {
  361. /*<       cvdist=cmplx(0.0e0,0.0e0) >*/
  362.     cvdist.r = (float)0., cvdist.i = (float)0.;
  363. /*<       go to (1000,110,120,130,140,160,170),kdisto >*/
  364.     switch (kdisto) {
  365.         case 1:  goto L1000;
  366.         case 2:  goto L110;
  367.         case 3:  goto L120;
  368.         case 4:  goto L130;
  369.         case 5:  goto L140;
  370.         case 6:  goto L160;
  371.         case 7:  goto L170;
  372.     }
  373. /*<   110 freqd=2.0d0*freq1 >*/
  374. L110:
  375.     freqd = freq1 * 2.;
  376. /*<       arg=dsqrt(2.0d0*rload*refprl)/(omag*omag) >*/
  377.     arg = sqrt(rload * 2. * ac_1.refprl) / (omag * omag);
  378. /*<       if (iprnt.eq.0) go to 200 >*/
  379.     if (iprnt == 0) {
  380.         goto L200;
  381.     }
  382. /*<       write (iofile,111) freq1,freqd,omag,ophase >*/
  383.     io__26.ciunit = status_1.iofile;
  384.     s_wsfe(&io__26);
  385.     do_fio(&c__1, (char *)&freq1, (ftnlen)sizeof(doublereal));
  386.     do_fio(&c__1, (char *)&freqd, (ftnlen)sizeof(doublereal));
  387.     do_fio(&c__1, (char *)&omag, (ftnlen)sizeof(doublereal));
  388.     do_fio(&c__1, (char *)&ophase, (ftnlen)sizeof(doublereal));
  389.     e_wsfe();
  390. /*<   111 format (///5x,'2nd harmonic distortion',30x,'freq1 = ',1pd9.2, >*/
  391. /*<      1   '  hz'//5x,'distortion frequency  ',d9.2,'  hz',16x, >*/
  392. /*<      2   'mag ',d9.3,3x,'phs ',0pf7.2) >*/
  393. /*<       go to 200 >*/
  394.     goto L200;
  395. /*<   120 freqd=3.0d0*freq1 >*/
  396. L120:
  397.     freqd = freq1 * 3.;
  398. /*<       arg=2.0d0*rload*refprl/(omag*omag*omag) >*/
  399.     arg = rload * 2. * ac_1.refprl / (omag * omag * omag);
  400. /*<       if (iprnt.eq.0) go to 200 >*/
  401.     if (iprnt == 0) {
  402.         goto L200;
  403.     }
  404. /*<       write (iofile,121) freq1,freqd,omag,ophase >*/
  405.     io__27.ciunit = status_1.iofile;
  406.     s_wsfe(&io__27);
  407.     do_fio(&c__1, (char *)&freq1, (ftnlen)sizeof(doublereal));
  408.     do_fio(&c__1, (char *)&freqd, (ftnlen)sizeof(doublereal));
  409.     do_fio(&c__1, (char *)&omag, (ftnlen)sizeof(doublereal));
  410.     do_fio(&c__1, (char *)&ophase, (ftnlen)sizeof(doublereal));
  411.     e_wsfe();
  412. /*<   121 format (1h1,4x,'3rd harmonic distortion',30x,'freq1 = ',1pd9.2, >*/
  413. /*<      1   '  hz'//5x,'distortion frequency  ',d9.2,'  hz',16x, >*/
  414. /*<      2   'mag ',d9.3,3x,'phs ',0pf7.2) >*/
  415. /*<       go to 200 >*/
  416.     goto L200;
  417. /*<   130 freqd=freq2 >*/
  418. L130:
  419.     freqd = freq2;
  420. /*<       go to 200 >*/
  421.     goto L200;
  422. /*<   140 freqd=freq1-freq2 >*/
  423. L140:
  424.     freqd = freq1 - freq2;
  425. /*<       arg=dsqrt(2.0d0*rload*refprl)*spw2/(omag*omag) >*/
  426.     arg = sqrt(rload * 2. * ac_1.refprl) * ac_1.spw2 / (omag * omag);
  427. /*<       if (iprnt.eq.0) go to 200 >*/
  428.     if (iprnt == 0) {
  429.         goto L200;
  430.     }
  431. /*<       write (iofile,151) freq1,freq2,freqd,omag,ophase,ow2mag,ow2phs >*/
  432.     io__28.ciunit = status_1.iofile;
  433.     s_wsfe(&io__28);
  434.     do_fio(&c__1, (char *)&freq1, (ftnlen)sizeof(doublereal));
  435.     do_fio(&c__1, (char *)&freq2, (ftnlen)sizeof(doublereal));
  436.     do_fio(&c__1, (char *)&freqd, (ftnlen)sizeof(doublereal));
  437.     do_fio(&c__1, (char *)&omag, (ftnlen)sizeof(doublereal));
  438.     do_fio(&c__1, (char *)&ophase, (ftnlen)sizeof(doublereal));
  439.     do_fio(&c__1, (char *)&ow2mag, (ftnlen)sizeof(doublereal));
  440.     do_fio(&c__1, (char *)&ow2phs, (ftnlen)sizeof(doublereal));
  441.     e_wsfe();
  442. /*<   151 format (1h1,4x,'2nd order intermodulation difference component', >*/
  443. /*<      1   7x,'freq1 = ',1pd9.2,'  hz',15x,'freq2 = ',d9.2,'  hz'// >*/
  444. /*<      2   5x,'distortion frequency  ',d9.2,'  hz',16x,'mag ', >*/
  445. /*<      3   d9.3,3x,'phs ',0pf7.2,9x,'mag ',1pd9.3,3x,'phs ',0pf7.2) >*/
  446. /*<       go to 200 >*/
  447.     goto L200;
  448. /*<   160 freqd=freq1+freq2 >*/
  449. L160:
  450.     freqd = freq1 + freq2;
  451. /*<       arg=dsqrt(2.0d0*rload*refprl)*spw2/(omag*omag) >*/
  452.     arg = sqrt(rload * 2. * ac_1.refprl) * ac_1.spw2 / (omag * omag);
  453. /*<       if (iprnt.eq.0) go to 200 >*/
  454.     if (iprnt == 0) {
  455.         goto L200;
  456.     }
  457. /*<       write (iofile,161) freq1,freq2,freqd,omag,ophase,ow2mag,ow2phs >*/
  458.     io__31.ciunit = status_1.iofile;
  459.     s_wsfe(&io__31);
  460.     do_fio(&c__1, (char *)&freq1, (ftnlen)sizeof(doublereal));
  461.     do_fio(&c__1, (char *)&freq2, (ftnlen)sizeof(doublereal));
  462.     do_fio(&c__1, (char *)&freqd, (ftnlen)sizeof(doublereal));
  463.     do_fio(&c__1, (char *)&omag, (ftnlen)sizeof(doublereal));
  464.     do_fio(&c__1, (char *)&ophase, (ftnlen)sizeof(doublereal));
  465.     do_fio(&c__1, (char *)&ow2mag, (ftnlen)sizeof(doublereal));
  466.     do_fio(&c__1, (char *)&ow2phs, (ftnlen)sizeof(doublereal));
  467.     e_wsfe();
  468. /*<   161 format (1h1,4x,'2nd order intermodulation sum component', >*/
  469. /*<      1   14x,'freq1 = ',1pd9.2,'  hz',15x,'freq2 = ',d9.2,'  hz'// >*/
  470. /*<      2   5x,'distortion frequency  ',d9.2,'  hz',16x,'mag ', >*/
  471. /*<      3   d9.3,3x,'phs ',0pf7.2,9x,'mag ',1pd9.3,3x,'phs ',0pf7.2) >*/
  472. /*<       go to 200 >*/
  473.     goto L200;
  474. /*<   170 freqd=2.0d0*freq1-freq2 >*/
  475. L170:
  476.     freqd = freq1 * 2. - freq2;
  477. /*<       arg=2.0d0*rload*refprl*spw2/(omag*omag*omag) >*/
  478.     arg = rload * 2. * ac_1.refprl * ac_1.spw2 / (omag * omag * omag);
  479. /*<       if (iprnt.eq.0) go to 200 >*/
  480.     if (iprnt == 0) {
  481.         goto L200;
  482.     }
  483. /*<       write (iofile,171) freq1,freq2,freqd,omag,ophase,ow2mag,ow2phs >*/
  484.     io__32.ciunit = status_1.iofile;
  485.     s_wsfe(&io__32);
  486.     do_fio(&c__1, (char *)&freq1, (ftnlen)sizeof(doublereal));
  487.     do_fio(&c__1, (char *)&freq2, (ftnlen)sizeof(doublereal));
  488.     do_fio(&c__1, (char *)&freqd, (ftnlen)sizeof(doublereal));
  489.     do_fio(&c__1, (char *)&omag, (ftnlen)sizeof(doublereal));
  490.     do_fio(&c__1, (char *)&ophase, (ftnlen)sizeof(doublereal));
  491.     do_fio(&c__1, (char *)&ow2mag, (ftnlen)sizeof(doublereal));
  492.     do_fio(&c__1, (char *)&ow2phs, (ftnlen)sizeof(doublereal));
  493.     e_wsfe();
  494. /*<   171 format (1h1,4x,'3rd order intermodulation difference component', >*/
  495. /*<      1   7x,'freq1 = ',1pd9.2,'  hz',15x,'freq2 = ',d9.2,'  hz'// >*/
  496. /*<      2   5x,'distortion frequency  ',d9.2,'  hz',16x,'mag ', >*/
  497. /*<      3   d9.3,3x,'phs ',0pf7.2,9x,'mag ',1pd9.3,3x,'phs ',0pf7.2) >*/
  498.  
  499. /*  load and decompose y matrix */
  500.  
  501. /*<   200 omega=twopi*freqd >*/
  502. L200:
  503.     status_1.omega = knstnt_1.twopi * freqd;
  504. /*<       igoof=0 >*/
  505.     flags_1.igoof = 0;
  506. /*<       call acload >*/
  507.     acload_();
  508. /*<       call acdcmp >*/
  509.     acdcmp_();
  510. /*<       if (igoof.eq.0) go to 220 >*/
  511.     if (flags_1.igoof == 0) {
  512.         goto L220;
  513.     }
  514. /*<       write (iofile,211) igoof,freqd >*/
  515.     io__33.ciunit = status_1.iofile;
  516.     s_wsfe(&io__33);
  517.     do_fio(&c__1, (char *)&flags_1.igoof, (ftnlen)sizeof(integer));
  518.     do_fio(&c__1, (char *)&freqd, (ftnlen)sizeof(doublereal));
  519.     e_wsfe();
  520. /*<   211 format('0warning:  underflow ',i4,' time(s) in distortion analysis >*/
  521. /*<      1 at freq = ',1pd9.3,' hz') >*/
  522. /*<       igoof=0 >*/
  523.     flags_1.igoof = 0;
  524. /*<   220 if (kdisto.eq.4) go to 710 >*/
  525. L220:
  526.     if (kdisto == 4) {
  527.         goto L710;
  528.     }
  529.  
  530. /*  obtain adjoint solution */
  531.  
  532. /*<       call zero8(value(lvn+1),nstop) >*/
  533.     zero8_(&blank_1.value[tabinf_1.lvn], &cirdat_1.nstop);
  534. /*<       call zero8(value(imvn+1),nstop) >*/
  535.     zero8_(&blank_1.value[tabinf_1.imvn], &cirdat_1.nstop);
  536. /*<       value(lvn+idnp)=-1.0d0 >*/
  537.     blank_1.value[tabinf_1.lvn + idnp - 1] = -1.;
  538. /*<       value(lvn+idnn)=+1.0d0 >*/
  539.     blank_1.value[tabinf_1.lvn + idnn - 1] = 1.;
  540. /*<       call acasol >*/
  541.     acasol_();
  542. /*<       call copy16(cvalue(lcvn+1),cvalue(icvadj+1),nstop) >*/
  543.     copy16_(&cvalue[tabinf_1.lcvn], &cvalue[icvadj], &cirdat_1.nstop);
  544. /*<       call zero8(value(lvn+1),nstop) >*/
  545.     zero8_(&blank_1.value[tabinf_1.lvn], &cirdat_1.nstop);
  546. /*<       call zero8(value(imvn+1),nstop) >*/
  547.     zero8_(&blank_1.value[tabinf_1.imvn], &cirdat_1.nstop);
  548.  
  549. /*  bjts */
  550.  
  551. /*<       if (jelcnt(12).eq.0) go to 500 >*/
  552.     if (cirdat_1.jelcnt[11] == 0) {
  553.         goto L500;
  554.     }
  555. /*<       ititle=0 >*/
  556.     ititle = 0;
  557. /*<   301 format (////1x,'bjt distortion components'//1x,'name',11x,'gm', >*/
  558. /*<      1   8x,'gpi',7x,'go',8x,'gmu',6x,'gmo2',7x,'cb',8x,'cbr',7x,'cje', >*/
  559. /*<      2   7x,'cjc',6x,'total') >*/
  560. /* L301: */
  561. /*<   311 format (////1x,'bjt distortion components'//1x,'name',11x,'gm', >*/
  562. /*<      1   8x,'gpi',7x,'go',8x,'gmu',6x,'gmo2',7x,'cb',8x,'cbr',7x,'cje', >*/
  563. /*<      2   7x,'cjc',6x,'gm203',5x,'gmo23',5x,'total') >*/
  564. /* L311: */
  565. /*<   320 loc=locate(12) >*/
  566. /* L320: */
  567.     loc = cirdat_1.locate[11];
  568. /*<   330 if ((loc.eq.0).or.(nodplc(loc+36).ne.0)) go to 500 >*/
  569. L330:
  570.     if (loc == 0 || nodplc[loc + 35] != 0) {
  571.         goto L500;
  572.     }
  573. /*<       locv=nodplc(loc+1) >*/
  574.     locv = nodplc[loc];
  575. /*<       loct=lx0+nodplc(loc+22) >*/
  576.     loct = tabinf_1.lx0 + nodplc[loc + 21];
  577. /*<       locd=ld0+nodplc(loc+23) >*/
  578.     locd = tabinf_1.ld0 + nodplc[loc + 22];
  579. /*<       node1=nodplc(loc+5) >*/
  580.     node1 = nodplc[loc + 4];
  581. /*<       node2=nodplc(loc+6) >*/
  582.     node2 = nodplc[loc + 5];
  583. /*<       node3=nodplc(loc+7) >*/
  584.     node3 = nodplc[loc + 6];
  585. /*<       cje1=value(locd) >*/
  586.     cje1 = blank_1.value[locd - 1];
  587. /*<       cje2=value(locd+1) >*/
  588.     cje2 = blank_1.value[locd];
  589. /*<       cjc1=value(locd+2) >*/
  590.     cjc1 = blank_1.value[locd + 1];
  591. /*<       cjc2=value(locd+3) >*/
  592.     cjc2 = blank_1.value[locd + 2];
  593. /*<       go2=value(locd+4) >*/
  594.     go2 = blank_1.value[locd + 3];
  595. /*<       gmo2=value(locd+5) >*/
  596.     gmo2 = blank_1.value[locd + 4];
  597. /*<       gm2=value(locd+6) >*/
  598.     gm2 = blank_1.value[locd + 5];
  599. /*<       gmu2=value(locd+7) >*/
  600.     gmu2 = blank_1.value[locd + 6];
  601. /*<       gpi2=value(locd+8) >*/
  602.     gpi2 = blank_1.value[locd + 7];
  603. /*<       cb1=value(locd+11) >*/
  604.     cb1 = blank_1.value[locd + 10];
  605. /*<       cb1r=value(locd+12) >*/
  606.     cb1r = blank_1.value[locd + 11];
  607. /*<       go3=value(locd+13) >*/
  608.     go3 = blank_1.value[locd + 12];
  609. /*<       gmo23=value(locd+14) >*/
  610.     gmo23 = blank_1.value[locd + 13];
  611. /*<       gm2o3=value(locd+15) >*/
  612.     gm2o3 = blank_1.value[locd + 14];
  613. /*<       gm3=value(locd+16) >*/
  614.     gm3 = blank_1.value[locd + 15];
  615. /*<       gmu3=value(locd+17) >*/
  616.     gmu3 = blank_1.value[locd + 16];
  617. /*<       gpi3=value(locd+18) >*/
  618.     gpi3 = blank_1.value[locd + 17];
  619. /*<       cb2=value(locd+19) >*/
  620.     cb2 = blank_1.value[locd + 18];
  621. /*<       cb2r=value(locd+20) >*/
  622.     cb2r = blank_1.value[locd + 19];
  623. /*<       bew=cvalue(icvw1+node2)-cvalue(icvw1+node3) >*/
  624.     i_1 = icvw1 + node2 - 1;
  625.     i_2 = icvw1 + node3 - 1;
  626.     q_1.r = cvalue[i_1].r - cvalue[i_2].r, q_1.i = cvalue[i_1].i - cvalue[
  627.         i_2].i;
  628.     bew.r = q_1.r, bew.i = q_1.i;
  629. /*<       cew=cvalue(icvw1+node1)-cvalue(icvw1+node3) >*/
  630.     i_1 = icvw1 + node1 - 1;
  631.     i_2 = icvw1 + node3 - 1;
  632.     q_1.r = cvalue[i_1].r - cvalue[i_2].r, q_1.i = cvalue[i_1].i - cvalue[
  633.         i_2].i;
  634.     cew.r = q_1.r, cew.i = q_1.i;
  635. /*<       bcw=cvalue(icvw1+node2)-cvalue(icvw1+node1) >*/
  636.     i_1 = icvw1 + node2 - 1;
  637.     i_2 = icvw1 + node1 - 1;
  638.     q_1.r = cvalue[i_1].r - cvalue[i_2].r, q_1.i = cvalue[i_1].i - cvalue[
  639.         i_2].i;
  640.     bcw.r = q_1.r, bcw.i = q_1.i;
  641. /*<       if (kdisto.eq.2) go to 370 >*/
  642.     if (kdisto == 2) {
  643.         goto L370;
  644.     }
  645. /*<       be2w=cvalue(icv2w1+node2)-cvalue(icv2w1+node3) >*/
  646.     i_1 = icv2w1 + node2 - 1;
  647.     i_2 = icv2w1 + node3 - 1;
  648.     q_1.r = cvalue[i_1].r - cvalue[i_2].r, q_1.i = cvalue[i_1].i - cvalue[
  649.         i_2].i;
  650.     be2w.r = q_1.r, be2w.i = q_1.i;
  651. /*<       ce2w=cvalue(icv2w1+node1)-cvalue(icv2w1+node3) >*/
  652.     i_1 = icv2w1 + node1 - 1;
  653.     i_2 = icv2w1 + node3 - 1;
  654.     q_1.r = cvalue[i_1].r - cvalue[i_2].r, q_1.i = cvalue[i_1].i - cvalue[
  655.         i_2].i;
  656.     ce2w.r = q_1.r, ce2w.i = q_1.i;
  657. /*<       bc2w=cvalue(icv2w1+node2)-cvalue(icv2w1+node1) >*/
  658.     i_1 = icv2w1 + node2 - 1;
  659.     i_2 = icv2w1 + node1 - 1;
  660.     q_1.r = cvalue[i_1].r - cvalue[i_2].r, q_1.i = cvalue[i_1].i - cvalue[
  661.         i_2].i;
  662.     bc2w.r = q_1.r, bc2w.i = q_1.i;
  663. /*<       if (kdisto.eq.3) go to 380 >*/
  664.     if (kdisto == 3) {
  665.         goto L380;
  666.     }
  667. /*<       bew2=cvalue(icvw2+node2)-cvalue(icvw2+node3) >*/
  668.     i_1 = icvw2 + node2 - 1;
  669.     i_2 = icvw2 + node3 - 1;
  670.     q_1.r = cvalue[i_1].r - cvalue[i_2].r, q_1.i = cvalue[i_1].i - cvalue[
  671.         i_2].i;
  672.     bew2.r = q_1.r, bew2.i = q_1.i;
  673. /*<       cew2=cvalue(icvw2+node1)-cvalue(icvw2+node3) >*/
  674.     i_1 = icvw2 + node1 - 1;
  675.     i_2 = icvw2 + node3 - 1;
  676.     q_1.r = cvalue[i_1].r - cvalue[i_2].r, q_1.i = cvalue[i_1].i - cvalue[
  677.         i_2].i;
  678.     cew2.r = q_1.r, cew2.i = q_1.i;
  679. /*<       bcw2=cvalue(icvw2+node2)-cvalue(icvw2+node1) >*/
  680.     i_1 = icvw2 + node2 - 1;
  681.     i_2 = icvw2 + node1 - 1;
  682.     q_1.r = cvalue[i_1].r - cvalue[i_2].r, q_1.i = cvalue[i_1].i - cvalue[
  683.         i_2].i;
  684.     bcw2.r = q_1.r, bcw2.i = q_1.i;
  685. /*<       if (kdisto.eq.5) go to 390 >*/
  686.     if (kdisto == 5) {
  687.         goto L390;
  688.     }
  689. /*<       if (kdisto.eq.6) go to 400 >*/
  690.     if (kdisto == 6) {
  691.         goto L400;
  692.     }
  693. /*<       bew12=cvalue(icvw12+node2)-cvalue(icvw12+node3) >*/
  694.     i_1 = icvw12 + node2 - 1;
  695.     i_2 = icvw12 + node3 - 1;
  696.     q_1.r = cvalue[i_1].r - cvalue[i_2].r, q_1.i = cvalue[i_1].i - cvalue[
  697.         i_2].i;
  698.     bew12.r = q_1.r, bew12.i = q_1.i;
  699. /*<       cew12=cvalue(icvw12+node1)-cvalue(icvw12+node3) >*/
  700.     i_1 = icvw12 + node1 - 1;
  701.     i_2 = icvw12 + node3 - 1;
  702.     q_1.r = cvalue[i_1].r - cvalue[i_2].r, q_1.i = cvalue[i_1].i - cvalue[
  703.         i_2].i;
  704.     cew12.r = q_1.r, cew12.i = q_1.i;
  705. /*<       bcw12=cvalue(icvw12+node2)-cvalue(icvw12+node1) >*/
  706.     i_1 = icvw12 + node2 - 1;
  707.     i_2 = icvw12 + node1 - 1;
  708.     q_1.r = cvalue[i_1].r - cvalue[i_2].r, q_1.i = cvalue[i_1].i - cvalue[
  709.         i_2].i;
  710.     bcw12.r = q_1.r, bcw12.i = q_1.i;
  711. /*<       go to 410 >*/
  712.     goto L410;
  713.  
  714. /*  calculate hd2 current generators */
  715.  
  716. /*<   370 difvn1=0.5d0*cew*cew >*/
  717. L370:
  718.     z_2.r = cew.r * .5, z_2.i = cew.i * .5;
  719.     z_1.r = z_2.r * cew.r - z_2.i * cew.i, z_1.i = z_2.r * cew.i + z_2.i *
  720.          cew.r;
  721.     difvn1.r = z_1.r, difvn1.i = z_1.i;
  722. /*<       difvn2=0.5d0*bew*bew >*/
  723.     z_2.r = bew.r * .5, z_2.i = bew.i * .5;
  724.     z_1.r = z_2.r * bew.r - z_2.i * bew.i, z_1.i = z_2.r * bew.i + z_2.i *
  725.          bew.r;
  726.     difvn2.r = z_1.r, difvn2.i = z_1.i;
  727. /*<       difvn3=0.5d0*bcw*bcw >*/
  728.     z_2.r = bcw.r * .5, z_2.i = bcw.i * .5;
  729.     z_1.r = z_2.r * bcw.r - z_2.i * bcw.i, z_1.i = z_2.r * bcw.i + z_2.i *
  730.          bcw.r;
  731.     difvn3.r = z_1.r, difvn3.i = z_1.i;
  732. /*<       dsgmo2=gmo2*0.5d0*bew*cew >*/
  733.     d_1 = gmo2 * .5;
  734.     z_2.r = d_1 * bew.r, z_2.i = d_1 * bew.i;
  735.     z_1.r = z_2.r * cew.r - z_2.i * cew.i, z_1.i = z_2.r * cew.i + z_2.i *
  736.          cew.r;
  737.     dsgmo2.r = z_1.r, dsgmo2.i = z_1.i;
  738. /*<       go to 420 >*/
  739.     goto L420;
  740.  
  741. /*  calculate hd3 current generators */
  742.  
  743. /*<   380 difvi1=0.50d0*cew*ce2w >*/
  744. L380:
  745.     z_2.r = cew.r * .5, z_2.i = cew.i * .5;
  746.     z_1.r = z_2.r * ce2w.r - z_2.i * ce2w.i, z_1.i = z_2.r * ce2w.i + 
  747.         z_2.i * ce2w.r;
  748.     difvi1.r = z_1.r, difvi1.i = z_1.i;
  749. /*<       difvn1=0.25d0*cew*cew*cew >*/
  750.     z_3.r = cew.r * .25, z_3.i = cew.i * .25;
  751.     z_2.r = z_3.r * cew.r - z_3.i * cew.i, z_2.i = z_3.r * cew.i + z_3.i *
  752.          cew.r;
  753.     z_1.r = z_2.r * cew.r - z_2.i * cew.i, z_1.i = z_2.r * cew.i + z_2.i *
  754.          cew.r;
  755.     difvn1.r = z_1.r, difvn1.i = z_1.i;
  756. /*<       difvi2=0.50d0*bew*be2w >*/
  757.     z_2.r = bew.r * .5, z_2.i = bew.i * .5;
  758.     z_1.r = z_2.r * be2w.r - z_2.i * be2w.i, z_1.i = z_2.r * be2w.i + 
  759.         z_2.i * be2w.r;
  760.     difvi2.r = z_1.r, difvi2.i = z_1.i;
  761. /*<       difvn2=0.25d0*bew*bew*bew >*/
  762.     z_3.r = bew.r * .25, z_3.i = bew.i * .25;
  763.     z_2.r = z_3.r * bew.r - z_3.i * bew.i, z_2.i = z_3.r * bew.i + z_3.i *
  764.          bew.r;
  765.     z_1.r = z_2.r * bew.r - z_2.i * bew.i, z_1.i = z_2.r * bew.i + z_2.i *
  766.          bew.r;
  767.     difvn2.r = z_1.r, difvn2.i = z_1.i;
  768. /*<       difvi3=0.50d0*bcw*bc2w >*/
  769.     z_2.r = bcw.r * .5, z_2.i = bcw.i * .5;
  770.     z_1.r = z_2.r * bc2w.r - z_2.i * bc2w.i, z_1.i = z_2.r * bc2w.i + 
  771.         z_2.i * bc2w.r;
  772.     difvi3.r = z_1.r, difvi3.i = z_1.i;
  773. /*<       difvn3=0.25d0*bcw*bcw*bcw >*/
  774.     z_3.r = bcw.r * .25, z_3.i = bcw.i * .25;
  775.     z_2.r = z_3.r * bcw.r - z_3.i * bcw.i, z_2.i = z_3.r * bcw.i + z_3.i *
  776.          bcw.r;
  777.     z_1.r = z_2.r * bcw.r - z_2.i * bcw.i, z_1.i = z_2.r * bcw.i + z_2.i *
  778.          bcw.r;
  779.     difvn3.r = z_1.r, difvn3.i = z_1.i;
  780. /*<       dsgmo2=gmo2*(bew*ce2w+be2w*cew)*0.5d0 >*/
  781.     q_2.r = bew.r * ce2w.r - bew.i * ce2w.i, q_2.i = bew.r * ce2w.i + 
  782.         bew.i * ce2w.r;
  783.     q_3.r = be2w.r * cew.r - be2w.i * cew.i, q_3.i = be2w.r * cew.i + 
  784.         be2w.i * cew.r;
  785.     q_1.r = q_2.r + q_3.r, q_1.i = q_2.i + q_3.i;
  786.     z_2.r = gmo2 * q_1.r, z_2.i = gmo2 * q_1.i;
  787.     z_1.r = z_2.r * .5, z_1.i = z_2.i * .5;
  788.     dsgmo2.r = z_1.r, dsgmo2.i = z_1.i;
  789. /*<       go to 430 >*/
  790.     goto L430;
  791.  
  792. /*  calculate im2d current generators */
  793.  
  794. /*<   390 difvn1=cew*conjg(cew2) >*/
  795. L390:
  796.     r_cnjg(&q_2, &cew2);
  797.     q_1.r = cew.r * q_2.r - cew.i * q_2.i, q_1.i = cew.r * q_2.i + cew.i *
  798.          q_2.r;
  799.     difvn1.r = q_1.r, difvn1.i = q_1.i;
  800. /*<       difvn2=bew*conjg(bew2) >*/
  801.     r_cnjg(&q_2, &bew2);
  802.     q_1.r = bew.r * q_2.r - bew.i * q_2.i, q_1.i = bew.r * q_2.i + bew.i *
  803.          q_2.r;
  804.     difvn2.r = q_1.r, difvn2.i = q_1.i;
  805. /*<       difvn3=bcw*conjg(bcw2) >*/
  806.     r_cnjg(&q_2, &bcw2);
  807.     q_1.r = bcw.r * q_2.r - bcw.i * q_2.i, q_1.i = bcw.r * q_2.i + bcw.i *
  808.          q_2.r;
  809.     difvn3.r = q_1.r, difvn3.i = q_1.i;
  810. /*<       dsgmo2=gmo2*0.5d0*(bew*conjg(cew2)+cew*conjg(bew2)) >*/
  811.     d_1 = gmo2 * .5;
  812.     r_cnjg(&q_3, &cew2);
  813.     q_2.r = bew.r * q_3.r - bew.i * q_3.i, q_2.i = bew.r * q_3.i + bew.i *
  814.          q_3.r;
  815.     r_cnjg(&q_5, &bew2);
  816.     q_4.r = cew.r * q_5.r - cew.i * q_5.i, q_4.i = cew.r * q_5.i + cew.i *
  817.          q_5.r;
  818.     q_1.r = q_2.r + q_4.r, q_1.i = q_2.i + q_4.i;
  819.     z_1.r = d_1 * q_1.r, z_1.i = d_1 * q_1.i;
  820.     dsgmo2.r = z_1.r, dsgmo2.i = z_1.i;
  821. /*<       go to 420 >*/
  822.     goto L420;
  823.  
  824. /*  calculate im2s current generators */
  825.  
  826. /*<   400 difvn1=cew*cew2 >*/
  827. L400:
  828.     q_1.r = cew.r * cew2.r - cew.i * cew2.i, q_1.i = cew.r * cew2.i + 
  829.         cew.i * cew2.r;
  830.     difvn1.r = q_1.r, difvn1.i = q_1.i;
  831. /*<       difvn2=bew*bew2 >*/
  832.     q_1.r = bew.r * bew2.r - bew.i * bew2.i, q_1.i = bew.r * bew2.i + 
  833.         bew.i * bew2.r;
  834.     difvn2.r = q_1.r, difvn2.i = q_1.i;
  835. /*<       difvn3=bcw*bcw2 >*/
  836.     q_1.r = bcw.r * bcw2.r - bcw.i * bcw2.i, q_1.i = bcw.r * bcw2.i + 
  837.         bcw.i * bcw2.r;
  838.     difvn3.r = q_1.r, difvn3.i = q_1.i;
  839. /*<       dsgmo2=gmo2*0.5d0*(bew*cew2+bew2*cew) >*/
  840.     d_1 = gmo2 * .5;
  841.     q_2.r = bew.r * cew2.r - bew.i * cew2.i, q_2.i = bew.r * cew2.i + 
  842.         bew.i * cew2.r;
  843.     q_3.r = bew2.r * cew.r - bew2.i * cew.i, q_3.i = bew2.r * cew.i + 
  844.         bew2.i * cew.r;
  845.     q_1.r = q_2.r + q_3.r, q_1.i = q_2.i + q_3.i;
  846.     z_1.r = d_1 * q_1.r, z_1.i = d_1 * q_1.i;
  847.     dsgmo2.r = z_1.r, dsgmo2.i = z_1.i;
  848. /*<       go to 420 >*/
  849.     goto L420;
  850.  
  851. /*  calculate im3 current generators */
  852.  
  853. /*<   410 difvi1=0.5d0*(ce2w*conjg(cew2)+cew*cew12) >*/
  854. L410:
  855.     r_cnjg(&q_3, &cew2);
  856.     q_2.r = ce2w.r * q_3.r - ce2w.i * q_3.i, q_2.i = ce2w.r * q_3.i + 
  857.         ce2w.i * q_3.r;
  858.     q_4.r = cew.r * cew12.r - cew.i * cew12.i, q_4.i = cew.r * cew12.i + 
  859.         cew.i * cew12.r;
  860.     q_1.r = q_2.r + q_4.r, q_1.i = q_2.i + q_4.i;
  861.     z_1.r = q_1.r * .5, z_1.i = q_1.i * .5;
  862.     difvi1.r = z_1.r, difvi1.i = z_1.i;
  863. /*<       difvi2=0.5d0*(be2w*conjg(bew2)+bew*bew12) >*/
  864.     r_cnjg(&q_3, &bew2);
  865.     q_2.r = be2w.r * q_3.r - be2w.i * q_3.i, q_2.i = be2w.r * q_3.i + 
  866.         be2w.i * q_3.r;
  867.     q_4.r = bew.r * bew12.r - bew.i * bew12.i, q_4.i = bew.r * bew12.i + 
  868.         bew.i * bew12.r;
  869.     q_1.r = q_2.r + q_4.r, q_1.i = q_2.i + q_4.i;
  870.     z_1.r = q_1.r * .5, z_1.i = q_1.i * .5;
  871.     difvi2.r = z_1.r, difvi2.i = z_1.i;
  872. /*<       difvi3=0.5d0*(bc2w*conjg(bcw2)+bcw*bcw12) >*/
  873.     r_cnjg(&q_3, &bcw2);
  874.     q_2.r = bc2w.r * q_3.r - bc2w.i * q_3.i, q_2.i = bc2w.r * q_3.i + 
  875.         bc2w.i * q_3.r;
  876.     q_4.r = bcw.r * bcw12.r - bcw.i * bcw12.i, q_4.i = bcw.r * bcw12.i + 
  877.         bcw.i * bcw12.r;
  878.     q_1.r = q_2.r + q_4.r, q_1.i = q_2.i + q_4.i;
  879.     z_1.r = q_1.r * .5, z_1.i = q_1.i * .5;
  880.     difvi3.r = z_1.r, difvi3.i = z_1.i;
  881. /*<       difvn1=cew*cew*conjg(cew2)*0.75d0 >*/
  882.     q_2.r = cew.r * cew.r - cew.i * cew.i, q_2.i = cew.r * cew.i + cew.i *
  883.          cew.r;
  884.     r_cnjg(&q_3, &cew2);
  885.     q_1.r = q_2.r * q_3.r - q_2.i * q_3.i, q_1.i = q_2.r * q_3.i + q_2.i *
  886.          q_3.r;
  887.     z_1.r = q_1.r * .75, z_1.i = q_1.i * .75;
  888.     difvn1.r = z_1.r, difvn1.i = z_1.i;
  889. /*<       difvn2=bew*bew*conjg(bew2)*0.75d0 >*/
  890.     q_2.r = bew.r * bew.r - bew.i * bew.i, q_2.i = bew.r * bew.i + bew.i *
  891.          bew.r;
  892.     r_cnjg(&q_3, &bew2);
  893.     q_1.r = q_2.r * q_3.r - q_2.i * q_3.i, q_1.i = q_2.r * q_3.i + q_2.i *
  894.          q_3.r;
  895.     z_1.r = q_1.r * .75, z_1.i = q_1.i * .75;
  896.     difvn2.r = z_1.r, difvn2.i = z_1.i;
  897. /*<       difvn3=bcw*bcw*conjg(bcw2)*0.75d0 >*/
  898.     q_2.r = bcw.r * bcw.r - bcw.i * bcw.i, q_2.i = bcw.r * bcw.i + bcw.i *
  899.          bcw.r;
  900.     r_cnjg(&q_3, &bcw2);
  901.     q_1.r = q_2.r * q_3.r - q_2.i * q_3.i, q_1.i = q_2.r * q_3.i + q_2.i *
  902.          q_3.r;
  903.     z_1.r = q_1.r * .75, z_1.i = q_1.i * .75;
  904.     difvn3.r = z_1.r, difvn3.i = z_1.i;
  905. /*<       dsgmo2=gmo2*0.5d0*(conjg(bew2)*ce2w+bew*cew12+conjg(cew2)*be2w+ >*/
  906. /*<      1   cew*bew12) >*/
  907.     d_1 = gmo2 * .5;
  908.     r_cnjg(&q_5, &bew2);
  909.     q_4.r = q_5.r * ce2w.r - q_5.i * ce2w.i, q_4.i = q_5.r * ce2w.i + 
  910.         q_5.i * ce2w.r;
  911.     q_6.r = bew.r * cew12.r - bew.i * cew12.i, q_6.i = bew.r * cew12.i + 
  912.         bew.i * cew12.r;
  913.     q_3.r = q_4.r + q_6.r, q_3.i = q_4.i + q_6.i;
  914.     r_cnjg(&q_8, &cew2);
  915.     q_7.r = q_8.r * be2w.r - q_8.i * be2w.i, q_7.i = q_8.r * be2w.i + 
  916.         q_8.i * be2w.r;
  917.     q_2.r = q_3.r + q_7.r, q_2.i = q_3.i + q_7.i;
  918.     q_9.r = cew.r * bew12.r - cew.i * bew12.i, q_9.i = cew.r * bew12.i + 
  919.         cew.i * bew12.r;
  920.     q_1.r = q_2.r + q_9.r, q_1.i = q_2.i + q_9.i;
  921.     z_1.r = d_1 * q_1.r, z_1.i = d_1 * q_1.i;
  922.     dsgmo2.r = z_1.r, dsgmo2.i = z_1.i;
  923. /*<       go to 430 >*/
  924.     goto L430;
  925.  
  926. /*<   420 dsgo2=go2*difvn1 >*/
  927. L420:
  928.     z_1.r = go2 * difvn1.r, z_1.i = go2 * difvn1.i;
  929.     dsgo2.r = z_1.r, dsgo2.i = z_1.i;
  930. /*<       dsgm2=gm2*difvn2 >*/
  931.     z_1.r = gm2 * difvn2.r, z_1.i = gm2 * difvn2.i;
  932.     dsgm2.r = z_1.r, dsgm2.i = z_1.i;
  933. /*<       dsgmu2=gmu2*difvn3 >*/
  934.     z_1.r = gmu2 * difvn3.r, z_1.i = gmu2 * difvn3.i;
  935.     dsgmu2.r = z_1.r, dsgmu2.i = z_1.i;
  936. /*<       dsgpi2=gpi2*difvn2 >*/
  937.     z_1.r = gpi2 * difvn2.r, z_1.i = gpi2 * difvn2.i;
  938.     dsgpi2.r = z_1.r, dsgpi2.i = z_1.i;
  939. /*<       dscb1=0.5d0*cb1*omega*cmplx(-aimag(difvn2),real(difvn2)) >*/
  940.     d_1 = cb1 * .5 * status_1.omega;
  941.     d_2 = -(doublereal)r_imag(&difvn2);
  942.     d_3 = difvn2.r;
  943.     q_1.r = d_2, q_1.i = d_3;
  944.     z_1.r = d_1 * q_1.r, z_1.i = d_1 * q_1.i;
  945.     dscb1.r = z_1.r, dscb1.i = z_1.i;
  946. /*<       dscb1r=0.5d0*cb1r*omega*cmplx(-aimag(difvn3),real(difvn3)) >*/
  947.     d_1 = cb1r * .5 * status_1.omega;
  948.     d_2 = -(doublereal)r_imag(&difvn3);
  949.     d_3 = difvn3.r;
  950.     q_1.r = d_2, q_1.i = d_3;
  951.     z_1.r = d_1 * q_1.r, z_1.i = d_1 * q_1.i;
  952.     dscb1r.r = z_1.r, dscb1r.i = z_1.i;
  953. /*<       dscje1=0.5d0*cje1*omega*cmplx(-aimag(difvn2),real(difvn2)) >*/
  954.     d_1 = cje1 * .5 * status_1.omega;
  955.     d_2 = -(doublereal)r_imag(&difvn2);
  956.     d_3 = difvn2.r;
  957.     q_1.r = d_2, q_1.i = d_3;
  958.     z_1.r = d_1 * q_1.r, z_1.i = d_1 * q_1.i;
  959.     dscje1.r = z_1.r, dscje1.i = z_1.i;
  960. /*<       dscjc1=0.5d0*cjc1*omega*cmplx(-aimag(difvn3),real(difvn3)) >*/
  961.     d_1 = cjc1 * .5 * status_1.omega;
  962.     d_2 = -(doublereal)r_imag(&difvn3);
  963.     d_3 = difvn3.r;
  964.     q_1.r = d_2, q_1.i = d_3;
  965.     z_1.r = d_1 * q_1.r, z_1.i = d_1 * q_1.i;
  966.     dscjc1.r = z_1.r, dscjc1.i = z_1.i;
  967. /*<       go to 440 >*/
  968.     goto L440;
  969.  
  970. /*<   430 dsgo2=2.0d0*go2*difvi1+go3*difvn1 >*/
  971. L430:
  972.     d_1 = go2 * 2.;
  973.     z_2.r = d_1 * difvi1.r, z_2.i = d_1 * difvi1.i;
  974.     z_3.r = go3 * difvn1.r, z_3.i = go3 * difvn1.i;
  975.     z_1.r = z_2.r + z_3.r, z_1.i = z_2.i + z_3.i;
  976.     dsgo2.r = z_1.r, dsgo2.i = z_1.i;
  977. /*<       dsgm2=2.0d0*gm2*difvi2+gm3*difvn2 >*/
  978.     d_1 = gm2 * 2.;
  979.     z_2.r = d_1 * difvi2.r, z_2.i = d_1 * difvi2.i;
  980.     z_3.r = gm3 * difvn2.r, z_3.i = gm3 * difvn2.i;
  981.     z_1.r = z_2.r + z_3.r, z_1.i = z_2.i + z_3.i;
  982.     dsgm2.r = z_1.r, dsgm2.i = z_1.i;
  983. /*<       dsgmu2=2.0d0*gmu2*difvi3+gmu3*difvn3 >*/
  984.     d_1 = gmu2 * 2.;
  985.     z_2.r = d_1 * difvi3.r, z_2.i = d_1 * difvi3.i;
  986.     z_3.r = gmu3 * difvn3.r, z_3.i = gmu3 * difvn3.i;
  987.     z_1.r = z_2.r + z_3.r, z_1.i = z_2.i + z_3.i;
  988.     dsgmu2.r = z_1.r, dsgmu2.i = z_1.i;
  989. /*<       dsgpi2=2.0d0*gpi2*difvi2+gpi3*difvn2 >*/
  990.     d_1 = gpi2 * 2.;
  991.     z_2.r = d_1 * difvi2.r, z_2.i = d_1 * difvi2.i;
  992.     z_3.r = gpi3 * difvn2.r, z_3.i = gpi3 * difvn2.i;
  993.     z_1.r = z_2.r + z_3.r, z_1.i = z_2.i + z_3.i;
  994.     dsgpi2.r = z_1.r, dsgpi2.i = z_1.i;
  995. /*<       dscb1=omega*(cb1*difvi2+cb2*difvn2/3.0d0) >*/
  996.     z_3.r = cb1 * difvi2.r, z_3.i = cb1 * difvi2.i;
  997.     z_5.r = cb2 * difvn2.r, z_5.i = cb2 * difvn2.i;
  998.     z_4.r = z_5.r / 3., z_4.i = z_5.i / 3.;
  999.     z_2.r = z_3.r + z_4.r, z_2.i = z_3.i + z_4.i;
  1000.     z_1.r = status_1.omega * z_2.r, z_1.i = status_1.omega * z_2.i;
  1001.     dscb1.r = z_1.r, dscb1.i = z_1.i;
  1002. /*<       dscb1=cmplx(-aimag(dscb1),real(dscb1)) >*/
  1003.     d_1 = -(doublereal)r_imag(&dscb1);
  1004.     d_2 = dscb1.r;
  1005.     q_1.r = d_1, q_1.i = d_2;
  1006.     dscb1.r = q_1.r, dscb1.i = q_1.i;
  1007. /*<       dscb1r=omega*(cb1r*difvi3+cb2r*difvn3/3.0d0) >*/
  1008.     z_3.r = cb1r * difvi3.r, z_3.i = cb1r * difvi3.i;
  1009.     z_5.r = cb2r * difvn3.r, z_5.i = cb2r * difvn3.i;
  1010.     z_4.r = z_5.r / 3., z_4.i = z_5.i / 3.;
  1011.     z_2.r = z_3.r + z_4.r, z_2.i = z_3.i + z_4.i;
  1012.     z_1.r = status_1.omega * z_2.r, z_1.i = status_1.omega * z_2.i;
  1013.     dscb1r.r = z_1.r, dscb1r.i = z_1.i;
  1014. /*<       dscb1r=cmplx(-aimag(dscb1r),real(dscb1r)) >*/
  1015.     d_1 = -(doublereal)r_imag(&dscb1r);
  1016.     d_2 = dscb1r.r;
  1017.     q_1.r = d_1, q_1.i = d_2;
  1018.     dscb1r.r = q_1.r, dscb1r.i = q_1.i;
  1019. /*<       dscje1=omega*(cje1*difvi2+cje2*difvn2/3.0d0) >*/
  1020.     z_3.r = cje1 * difvi2.r, z_3.i = cje1 * difvi2.i;
  1021.     z_5.r = cje2 * difvn2.r, z_5.i = cje2 * difvn2.i;
  1022.     z_4.r = z_5.r / 3., z_4.i = z_5.i / 3.;
  1023.     z_2.r = z_3.r + z_4.r, z_2.i = z_3.i + z_4.i;
  1024.     z_1.r = status_1.omega * z_2.r, z_1.i = status_1.omega * z_2.i;
  1025.     dscje1.r = z_1.r, dscje1.i = z_1.i;
  1026. /*<       dscje1=cmplx(-aimag(dscje1),real(dscje1)) >*/
  1027.     d_1 = -(doublereal)r_imag(&dscje1);
  1028.     d_2 = dscje1.r;
  1029.     q_1.r = d_1, q_1.i = d_2;
  1030.     dscje1.r = q_1.r, dscje1.i = q_1.i;
  1031. /*<       dscjc1=omega*(cjc1*difvi3+cjc2*difvn3/3.0d0) >*/
  1032.     z_3.r = cjc1 * difvi3.r, z_3.i = cjc1 * difvi3.i;
  1033.     z_5.r = cjc2 * difvn3.r, z_5.i = cjc2 * difvn3.i;
  1034.     z_4.r = z_5.r / 3., z_4.i = z_5.i / 3.;
  1035.     z_2.r = z_3.r + z_4.r, z_2.i = z_3.i + z_4.i;
  1036.     z_1.r = status_1.omega * z_2.r, z_1.i = status_1.omega * z_2.i;
  1037.     dscjc1.r = z_1.r, dscjc1.i = z_1.i;
  1038. /*<       dscjc1=cmplx(-aimag(dscjc1),real(dscjc1)) >*/
  1039.     d_1 = -(doublereal)r_imag(&dscjc1);
  1040.     d_2 = dscjc1.r;
  1041.     q_1.r = d_1, q_1.i = d_2;
  1042.     dscjc1.r = q_1.r, dscjc1.i = q_1.i;
  1043.  
  1044. /*  determine contribution of each distortion source */
  1045.  
  1046. /*<   440 cvabe=cvalue(icvadj+node2)-cvalue(icvadj+node3) >*/
  1047. L440:
  1048.     i_1 = icvadj + node2 - 1;
  1049.     i_2 = icvadj + node3 - 1;
  1050.     q_1.r = cvalue[i_1].r - cvalue[i_2].r, q_1.i = cvalue[i_1].i - cvalue[
  1051.         i_2].i;
  1052.     cvabe.r = q_1.r, cvabe.i = q_1.i;
  1053. /*<       cvabc=cvalue(icvadj+node2)-cvalue(icvadj+node1) >*/
  1054.     i_1 = icvadj + node2 - 1;
  1055.     i_2 = icvadj + node1 - 1;
  1056.     q_1.r = cvalue[i_1].r - cvalue[i_2].r, q_1.i = cvalue[i_1].i - cvalue[
  1057.         i_2].i;
  1058.     cvabc.r = q_1.r, cvabc.i = q_1.i;
  1059. /*<       cvace=cvalue(icvadj+node1)-cvalue(icvadj+node3) >*/
  1060.     i_1 = icvadj + node1 - 1;
  1061.     i_2 = icvadj + node3 - 1;
  1062.     q_1.r = cvalue[i_1].r - cvalue[i_2].r, q_1.i = cvalue[i_1].i - cvalue[
  1063.         i_2].i;
  1064.     cvace.r = q_1.r, cvace.i = q_1.i;
  1065. /*<       disto1=dsgm2+dsgo2+dsgmo2 >*/
  1066.     q_2.r = dsgm2.r + dsgo2.r, q_2.i = dsgm2.i + dsgo2.i;
  1067.     q_1.r = q_2.r + dsgmo2.r, q_1.i = q_2.i + dsgmo2.i;
  1068.     disto1.r = q_1.r, disto1.i = q_1.i;
  1069. /*<       disto2=dsgpi2+dscb1+dscje1 >*/
  1070.     q_2.r = dsgpi2.r + dscb1.r, q_2.i = dsgpi2.i + dscb1.i;
  1071.     q_1.r = q_2.r + dscje1.r, q_1.i = q_2.i + dscje1.i;
  1072.     disto2.r = q_1.r, disto2.i = q_1.i;
  1073. /*<       disto3=dsgmu2+dscb1r+dscjc1 >*/
  1074.     q_2.r = dsgmu2.r + dscb1r.r, q_2.i = dsgmu2.i + dscb1r.i;
  1075.     q_1.r = q_2.r + dscjc1.r, q_1.i = q_2.i + dscjc1.i;
  1076.     disto3.r = q_1.r, disto3.i = q_1.i;
  1077. /*<       cvdo(1)=dsgm2*cvace*arg >*/
  1078.     q_1.r = dsgm2.r * cvace.r - dsgm2.i * cvace.i, q_1.i = dsgm2.r * 
  1079.         cvace.i + dsgm2.i * cvace.r;
  1080.     z_1.r = arg * q_1.r, z_1.i = arg * q_1.i;
  1081.     cvdo[0].r = z_1.r, cvdo[0].i = z_1.i;
  1082. /*<       cvdo(2)=dsgpi2*cvabe*arg >*/
  1083.     q_1.r = dsgpi2.r * cvabe.r - dsgpi2.i * cvabe.i, q_1.i = dsgpi2.r * 
  1084.         cvabe.i + dsgpi2.i * cvabe.r;
  1085.     z_1.r = arg * q_1.r, z_1.i = arg * q_1.i;
  1086.     cvdo[1].r = z_1.r, cvdo[1].i = z_1.i;
  1087. /*<       cvdo(3)=dsgo2*cvace*arg >*/
  1088.     q_1.r = dsgo2.r * cvace.r - dsgo2.i * cvace.i, q_1.i = dsgo2.r * 
  1089.         cvace.i + dsgo2.i * cvace.r;
  1090.     z_1.r = arg * q_1.r, z_1.i = arg * q_1.i;
  1091.     cvdo[2].r = z_1.r, cvdo[2].i = z_1.i;
  1092. /*<       cvdo(4)=dsgmu2*cvabc*arg >*/
  1093.     q_1.r = dsgmu2.r * cvabc.r - dsgmu2.i * cvabc.i, q_1.i = dsgmu2.r * 
  1094.         cvabc.i + dsgmu2.i * cvabc.r;
  1095.     z_1.r = arg * q_1.r, z_1.i = arg * q_1.i;
  1096.     cvdo[3].r = z_1.r, cvdo[3].i = z_1.i;
  1097. /*<       cvdo(5)=dsgmo2*cvace*arg >*/
  1098.     q_1.r = dsgmo2.r * cvace.r - dsgmo2.i * cvace.i, q_1.i = dsgmo2.r * 
  1099.         cvace.i + dsgmo2.i * cvace.r;
  1100.     z_1.r = arg * q_1.r, z_1.i = arg * q_1.i;
  1101.     cvdo[4].r = z_1.r, cvdo[4].i = z_1.i;
  1102. /*<       cvdo(6)=dscb1*cvabe*arg >*/
  1103.     q_1.r = dscb1.r * cvabe.r - dscb1.i * cvabe.i, q_1.i = dscb1.r * 
  1104.         cvabe.i + dscb1.i * cvabe.r;
  1105.     z_1.r = arg * q_1.r, z_1.i = arg * q_1.i;
  1106.     cvdo[5].r = z_1.r, cvdo[5].i = z_1.i;
  1107. /*<       cvdo(7)=dscb1r*cvabc*arg >*/
  1108.     q_1.r = dscb1r.r * cvabc.r - dscb1r.i * cvabc.i, q_1.i = dscb1r.r * 
  1109.         cvabc.i + dscb1r.i * cvabc.r;
  1110.     z_1.r = arg * q_1.r, z_1.i = arg * q_1.i;
  1111.     cvdo[6].r = z_1.r, cvdo[6].i = z_1.i;
  1112. /*<       cvdo(8)=dscje1*cvabe*arg >*/
  1113.     q_1.r = dscje1.r * cvabe.r - dscje1.i * cvabe.i, q_1.i = dscje1.r * 
  1114.         cvabe.i + dscje1.i * cvabe.r;
  1115.     z_1.r = arg * q_1.r, z_1.i = arg * q_1.i;
  1116.     cvdo[7].r = z_1.r, cvdo[7].i = z_1.i;
  1117. /*<       cvdo(9)=dscjc1*cvabc*arg >*/
  1118.     q_1.r = dscjc1.r * cvabc.r - dscjc1.i * cvabc.i, q_1.i = dscjc1.r * 
  1119.         cvabc.i + dscjc1.i * cvabc.r;
  1120.     z_1.r = arg * q_1.r, z_1.i = arg * q_1.i;
  1121.     cvdo[8].r = z_1.r, cvdo[8].i = z_1.i;
  1122. /*<       if (kdisto.eq.3) go to 450 >*/
  1123.     if (kdisto == 3) {
  1124.         goto L450;
  1125.     }
  1126. /*<       if (kdisto.eq.7) go to 460 >*/
  1127.     if (kdisto == 7) {
  1128.         goto L460;
  1129.     }
  1130. /*<       cvdo(10)=cvdo(1)+cvdo(2)+cvdo(3)+cvdo(4)+cvdo(5)+cvdo(6)+cvdo(7)+ >*/
  1131. /*<      1   cvdo(8)+cvdo(9) >*/
  1132.     q_8.r = cvdo[0].r + cvdo[1].r, q_8.i = cvdo[0].i + cvdo[1].i;
  1133.     q_7.r = q_8.r + cvdo[2].r, q_7.i = q_8.i + cvdo[2].i;
  1134.     q_6.r = q_7.r + cvdo[3].r, q_6.i = q_7.i + cvdo[3].i;
  1135.     q_5.r = q_6.r + cvdo[4].r, q_5.i = q_6.i + cvdo[4].i;
  1136.     q_4.r = q_5.r + cvdo[5].r, q_4.i = q_5.i + cvdo[5].i;
  1137.     q_3.r = q_4.r + cvdo[6].r, q_3.i = q_4.i + cvdo[6].i;
  1138.     q_2.r = q_3.r + cvdo[7].r, q_2.i = q_3.i + cvdo[7].i;
  1139.     q_1.r = q_2.r + cvdo[8].r, q_1.i = q_2.i + cvdo[8].i;
  1140.     cvdo[9].r = q_1.r, cvdo[9].i = q_1.i;
  1141. /*<       cvdist=cvdist+cvdo(10) >*/
  1142.     q_1.r = cvdist.r + cvdo[9].r, q_1.i = cvdist.i + cvdo[9].i;
  1143.     cvdist.r = q_1.r, cvdist.i = q_1.i;
  1144. /*<       if (iprnt.eq.0) go to 480 >*/
  1145.     if (iprnt == 0) {
  1146.         goto L480;
  1147.     }
  1148. /*<       do 445 j=1,10 >*/
  1149.     for (j = 1; j <= 10; ++j) {
  1150. /*<       call magphs(cvdo(j),xmag,xphs) >*/
  1151.         magphs_(&cvdo[j - 1], &xmag, &xphs);
  1152. /*<       cvdo(j)=cmplx(sngl(xmag),sngl(xphs)) >*/
  1153.         i_1 = j - 1;
  1154.         d_1 = xmag;
  1155.         d_2 = xphs;
  1156.         q_1.r = d_1, q_1.i = d_2;
  1157.         cvdo[i_1].r = q_1.r, cvdo[i_1].i = q_1.i;
  1158. /*<   445 continue >*/
  1159. /* L445: */
  1160.     }
  1161. /*<       if (ititle.eq.0) write (iofile,301) >*/
  1162.     if (ititle == 0) {
  1163.         io__96.ciunit = status_1.iofile;
  1164.         s_wsfe(&io__96);
  1165.         e_wsfe();
  1166.     }
  1167. /*<       ititle=1 >*/
  1168.     ititle = 1;
  1169. /*<       write (iofile,446) value(locv),(vdo(1,j),j=1,10) >*/
  1170.     io__97.ciunit = status_1.iofile;
  1171.     s_wsfe(&io__97);
  1172.     do_fio(&c__1, (char *)&blank_1.value[locv - 1], (ftnlen)sizeof(
  1173.         doublereal));
  1174.     for (j = 1; j <= 10; ++j) {
  1175.         do_fio(&c__1, (char *)&vdo[(j << 1) - 2], (ftnlen)sizeof(real));
  1176.     }
  1177.     e_wsfe();
  1178. /*<   446 format(1h0,a8,'mag',1p12d10.3) >*/
  1179. /*<       write (iofile,447) (vdo(2,j),j=1,10) >*/
  1180.     io__98.ciunit = status_1.iofile;
  1181.     s_wsfe(&io__98);
  1182.     for (j = 1; j <= 10; ++j) {
  1183.         do_fio(&c__1, (char *)&vdo[(j << 1) - 1], (ftnlen)sizeof(real));
  1184.     }
  1185.     e_wsfe();
  1186. /*<   447 format(9x,'phs',12(1x,f7.2,2x)) >*/
  1187. /*<       go to 480 >*/
  1188.     goto L480;
  1189. /*<   450 dgm2o3=gm2o3*cew*bew*bew*0.25d0 >*/
  1190. L450:
  1191.     z_4.r = gm2o3 * cew.r, z_4.i = gm2o3 * cew.i;
  1192.     z_3.r = z_4.r * bew.r - z_4.i * bew.i, z_3.i = z_4.r * bew.i + z_4.i *
  1193.          bew.r;
  1194.     z_2.r = z_3.r * bew.r - z_3.i * bew.i, z_2.i = z_3.r * bew.i + z_3.i *
  1195.          bew.r;
  1196.     z_1.r = z_2.r * .25, z_1.i = z_2.i * .25;
  1197.     dgm2o3.r = z_1.r, dgm2o3.i = z_1.i;
  1198. /*<       dgmo23=gmo23*bew*cew*cew*0.25d0 >*/
  1199.     z_4.r = gmo23 * bew.r, z_4.i = gmo23 * bew.i;
  1200.     z_3.r = z_4.r * cew.r - z_4.i * cew.i, z_3.i = z_4.r * cew.i + z_4.i *
  1201.          cew.r;
  1202.     z_2.r = z_3.r * cew.r - z_3.i * cew.i, z_2.i = z_3.r * cew.i + z_3.i *
  1203.          cew.r;
  1204.     z_1.r = z_2.r * .25, z_1.i = z_2.i * .25;
  1205.     dgmo23.r = z_1.r, dgmo23.i = z_1.i;
  1206. /*<       go to 470 >*/
  1207.     goto L470;
  1208. /*<   460 dgm2o3=gm2o3*(0.5d0*bew*conjg(bew2)*cew+0.25d0*bew*bew* >*/
  1209. /*<      1  conjg(cew2)) >*/
  1210. L460:
  1211.     z_5.r = bew.r * .5, z_5.i = bew.i * .5;
  1212.     r_cnjg(&q_1, &bew2);
  1213.     z_4.r = z_5.r * q_1.r - z_5.i * q_1.i, z_4.i = z_5.r * q_1.i + z_5.i *
  1214.          q_1.r;
  1215.     z_3.r = z_4.r * cew.r - z_4.i * cew.i, z_3.i = z_4.r * cew.i + z_4.i *
  1216.          cew.r;
  1217.     z_8.r = bew.r * .25, z_8.i = bew.i * .25;
  1218.     z_7.r = z_8.r * bew.r - z_8.i * bew.i, z_7.i = z_8.r * bew.i + z_8.i *
  1219.          bew.r;
  1220.     r_cnjg(&q_2, &cew2);
  1221.     z_6.r = z_7.r * q_2.r - z_7.i * q_2.i, z_6.i = z_7.r * q_2.i + z_7.i *
  1222.          q_2.r;
  1223.     z_2.r = z_3.r + z_6.r, z_2.i = z_3.i + z_6.i;
  1224.     z_1.r = gm2o3 * z_2.r, z_1.i = gm2o3 * z_2.i;
  1225.     dgm2o3.r = z_1.r, dgm2o3.i = z_1.i;
  1226. /*<       dgmo23=gmo23*(0.5d0*cew*conjg(cew2)*bew+0.25d0*cew*cew* >*/
  1227. /*<      1  conjg(bew2)) >*/
  1228.     z_5.r = cew.r * .5, z_5.i = cew.i * .5;
  1229.     r_cnjg(&q_1, &cew2);
  1230.     z_4.r = z_5.r * q_1.r - z_5.i * q_1.i, z_4.i = z_5.r * q_1.i + z_5.i *
  1231.          q_1.r;
  1232.     z_3.r = z_4.r * bew.r - z_4.i * bew.i, z_3.i = z_4.r * bew.i + z_4.i *
  1233.          bew.r;
  1234.     z_8.r = cew.r * .25, z_8.i = cew.i * .25;
  1235.     z_7.r = z_8.r * cew.r - z_8.i * cew.i, z_7.i = z_8.r * cew.i + z_8.i *
  1236.          cew.r;
  1237.     r_cnjg(&q_2, &bew2);
  1238.     z_6.r = z_7.r * q_2.r - z_7.i * q_2.i, z_6.i = z_7.r * q_2.i + z_7.i *
  1239.          q_2.r;
  1240.     z_2.r = z_3.r + z_6.r, z_2.i = z_3.i + z_6.i;
  1241.     z_1.r = gmo23 * z_2.r, z_1.i = gmo23 * z_2.i;
  1242.     dgmo23.r = z_1.r, dgmo23.i = z_1.i;
  1243. /*<   470 disto1=disto1+dgm2o3+dgmo23 >*/
  1244. L470:
  1245.     q_2.r = disto1.r + dgm2o3.r, q_2.i = disto1.i + dgm2o3.i;
  1246.     q_1.r = q_2.r + dgmo23.r, q_1.i = q_2.i + dgmo23.i;
  1247.     disto1.r = q_1.r, disto1.i = q_1.i;
  1248. /*<       cvdo(10)=dgm2o3*cvace*arg >*/
  1249.     q_1.r = dgm2o3.r * cvace.r - dgm2o3.i * cvace.i, q_1.i = dgm2o3.r * 
  1250.         cvace.i + dgm2o3.i * cvace.r;
  1251.     z_1.r = arg * q_1.r, z_1.i = arg * q_1.i;
  1252.     cvdo[9].r = z_1.r, cvdo[9].i = z_1.i;
  1253. /*<       cvdo(11)=dgmo23*cvace*arg >*/
  1254.     q_1.r = dgmo23.r * cvace.r - dgmo23.i * cvace.i, q_1.i = dgmo23.r * 
  1255.         cvace.i + dgmo23.i * cvace.r;
  1256.     z_1.r = arg * q_1.r, z_1.i = arg * q_1.i;
  1257.     cvdo[10].r = z_1.r, cvdo[10].i = z_1.i;
  1258. /*<       cvdo(12)=cvdo(1)+cvdo(2)+cvdo(3)+cvdo(4)+cvdo(5)+cvdo(6)+cvdo(7)+ >*/
  1259. /*<      1   cvdo(8)+cvdo(9)+cvdo(10)+cvdo(11) >*/
  1260.     q_10.r = cvdo[0].r + cvdo[1].r, q_10.i = cvdo[0].i + cvdo[1].i;
  1261.     q_9.r = q_10.r + cvdo[2].r, q_9.i = q_10.i + cvdo[2].i;
  1262.     q_8.r = q_9.r + cvdo[3].r, q_8.i = q_9.i + cvdo[3].i;
  1263.     q_7.r = q_8.r + cvdo[4].r, q_7.i = q_8.i + cvdo[4].i;
  1264.     q_6.r = q_7.r + cvdo[5].r, q_6.i = q_7.i + cvdo[5].i;
  1265.     q_5.r = q_6.r + cvdo[6].r, q_5.i = q_6.i + cvdo[6].i;
  1266.     q_4.r = q_5.r + cvdo[7].r, q_4.i = q_5.i + cvdo[7].i;
  1267.     q_3.r = q_4.r + cvdo[8].r, q_3.i = q_4.i + cvdo[8].i;
  1268.     q_2.r = q_3.r + cvdo[9].r, q_2.i = q_3.i + cvdo[9].i;
  1269.     q_1.r = q_2.r + cvdo[10].r, q_1.i = q_2.i + cvdo[10].i;
  1270.     cvdo[11].r = q_1.r, cvdo[11].i = q_1.i;
  1271. /*<       cvdist=cvdist+cvdo(12) >*/
  1272.     q_1.r = cvdist.r + cvdo[11].r, q_1.i = cvdist.i + cvdo[11].i;
  1273.     cvdist.r = q_1.r, cvdist.i = q_1.i;
  1274. /*<       if (iprnt.eq.0) go to 480 >*/
  1275.     if (iprnt == 0) {
  1276.         goto L480;
  1277.     }
  1278. /*<       do 475 j=1,12 >*/
  1279.     for (j = 1; j <= 12; ++j) {
  1280. /*<       call magphs(cvdo(j),xmag,xphs) >*/
  1281.         magphs_(&cvdo[j - 1], &xmag, &xphs);
  1282. /*<       cvdo(j)=cmplx(sngl(xmag),sngl(xphs)) >*/
  1283.         i_1 = j - 1;
  1284.         d_1 = xmag;
  1285.         d_2 = xphs;
  1286.         q_1.r = d_1, q_1.i = d_2;
  1287.         cvdo[i_1].r = q_1.r, cvdo[i_1].i = q_1.i;
  1288. /*<   475 continue >*/
  1289. /* L475: */
  1290.     }
  1291. /*<       if (ititle.eq.0) write (iofile,311) >*/
  1292.     if (ititle == 0) {
  1293.         io__101.ciunit = status_1.iofile;
  1294.         s_wsfe(&io__101);
  1295.         e_wsfe();
  1296.     }
  1297. /*<       ititle=1 >*/
  1298.     ititle = 1;
  1299. /*<       write (iofile,446) value(locv),(vdo(1,j),j=1,12) >*/
  1300.     io__102.ciunit = status_1.iofile;
  1301.     s_wsfe(&io__102);
  1302.     do_fio(&c__1, (char *)&blank_1.value[locv - 1], (ftnlen)sizeof(
  1303.         doublereal));
  1304.     for (j = 1; j <= 12; ++j) {
  1305.         do_fio(&c__1, (char *)&vdo[(j << 1) - 2], (ftnlen)sizeof(real));
  1306.     }
  1307.     e_wsfe();
  1308. /*<       write (iofile,447) (vdo(2,j),j=1,12) >*/
  1309.     io__103.ciunit = status_1.iofile;
  1310.     s_wsfe(&io__103);
  1311.     for (j = 1; j <= 12; ++j) {
  1312.         do_fio(&c__1, (char *)&vdo[(j << 1) - 1], (ftnlen)sizeof(real));
  1313.     }
  1314.     e_wsfe();
  1315. /*<   480 value(lvn+node1)=value(lvn+node1) >*/
  1316. /*<      1  -real(disto1-disto3) >*/
  1317. L480:
  1318.     q_1.r = disto1.r - disto3.r, q_1.i = disto1.i - disto3.i;
  1319.     blank_1.value[tabinf_1.lvn + node1 - 1] -= q_1.r;
  1320. /*<       value(lvn+node2)=value(lvn+node2) >*/
  1321. /*<      1  -real(disto2+disto3) >*/
  1322.     q_1.r = disto2.r + disto3.r, q_1.i = disto2.i + disto3.i;
  1323.     blank_1.value[tabinf_1.lvn + node2 - 1] -= q_1.r;
  1324. /*<       value(lvn+node3)=value(lvn+node3) >*/
  1325. /*<      1  +real(disto1+disto2) >*/
  1326.     q_1.r = disto1.r + disto2.r, q_1.i = disto1.i + disto2.i;
  1327.     blank_1.value[tabinf_1.lvn + node3 - 1] += q_1.r;
  1328. /*<       value(imvn+node1)=value(imvn+node1) >*/
  1329. /*<      1  -aimag(disto1-disto3) >*/
  1330.     q_1.r = disto1.r - disto3.r, q_1.i = disto1.i - disto3.i;
  1331.     blank_1.value[tabinf_1.imvn + node1 - 1] -= r_imag(&q_1);
  1332. /*<       value(imvn+node2)=value(imvn+node2) >*/
  1333. /*<      1  -aimag(disto2+disto3) >*/
  1334.     q_1.r = disto2.r + disto3.r, q_1.i = disto2.i + disto3.i;
  1335.     blank_1.value[tabinf_1.imvn + node2 - 1] -= r_imag(&q_1);
  1336. /*<       value(imvn+node3)=value(imvn+node3) >*/
  1337. /*<      1  +aimag(disto1+disto2) >*/
  1338.     q_1.r = disto1.r + disto2.r, q_1.i = disto1.i + disto2.i;
  1339.     blank_1.value[tabinf_1.imvn + node3 - 1] += r_imag(&q_1);
  1340. /*<       loc=nodplc(loc) >*/
  1341.     loc = nodplc[loc - 1];
  1342. /*<       go to 330 >*/
  1343.     goto L330;
  1344.  
  1345. /*   junction diodes */
  1346.  
  1347. /*<   500 if (jelcnt(11).eq.0) go to 700 >*/
  1348. L500:
  1349.     if (cirdat_1.jelcnt[10] == 0) {
  1350.         goto L700;
  1351.     }
  1352. /*<       ititle=0 >*/
  1353.     ititle = 0;
  1354. /*<   501 format (////1x,'diode distortion components'//1x,'name', >*/
  1355. /*<      1   11x,'geq',7x,'cb',8x,'cj',7x,'total') >*/
  1356. /* L501: */
  1357. /*<   510 loc=locate(11) >*/
  1358. /* L510: */
  1359.     loc = cirdat_1.locate[10];
  1360. /*<   520 if ((loc.eq.0).or.(nodplc(loc+16).ne.0)) go to 700 >*/
  1361. L520:
  1362.     if (loc == 0 || nodplc[loc + 15] != 0) {
  1363.         goto L700;
  1364.     }
  1365. /*<       locv=nodplc(loc+1) >*/
  1366.     locv = nodplc[loc];
  1367. /*<       node1=nodplc(loc+2) >*/
  1368.     node1 = nodplc[loc + 1];
  1369. /*<       node2=nodplc(loc+3) >*/
  1370.     node2 = nodplc[loc + 2];
  1371. /*<       node3=nodplc(loc+4) >*/
  1372.     node3 = nodplc[loc + 3];
  1373. /*<       locm=nodplc(loc+5) >*/
  1374.     locm = nodplc[loc + 4];
  1375. /*<       locm=nodplc(locm+1) >*/
  1376.     locm = nodplc[locm];
  1377. /*<       loct=lx0+nodplc(loc+11) >*/
  1378.     loct = tabinf_1.lx0 + nodplc[loc + 10];
  1379. /*<       locd=ld0+nodplc(loc+12) >*/
  1380.     locd = tabinf_1.ld0 + nodplc[loc + 11];
  1381. /*<       cdj1=value(locd) >*/
  1382.     cdj1 = blank_1.value[locd - 1];
  1383. /*<       cdj2=value(locd+1) >*/
  1384.     cdj2 = blank_1.value[locd];
  1385. /*<       cdb1=value(locd+3) >*/
  1386.     cdb1 = blank_1.value[locd + 2];
  1387. /*<       geq2=value(locd+4) >*/
  1388.     geq2 = blank_1.value[locd + 3];
  1389. /*<       geq3=value(locd+5) >*/
  1390.     geq3 = blank_1.value[locd + 4];
  1391. /*<       cdb2=value(locd+6) >*/
  1392.     cdb2 = blank_1.value[locd + 5];
  1393. /*<       bew=cvalue(icvw1+node3)-cvalue(icvw1+node2) >*/
  1394.     i_1 = icvw1 + node3 - 1;
  1395.     i_2 = icvw1 + node2 - 1;
  1396.     q_1.r = cvalue[i_1].r - cvalue[i_2].r, q_1.i = cvalue[i_1].i - cvalue[
  1397.         i_2].i;
  1398.     bew.r = q_1.r, bew.i = q_1.i;
  1399. /*<       if (kdisto.eq.2) go to 540 >*/
  1400.     if (kdisto == 2) {
  1401.         goto L540;
  1402.     }
  1403. /*<       be2w=cvalue(icv2w1+node3)-cvalue(icv2w1+node2) >*/
  1404.     i_1 = icv2w1 + node3 - 1;
  1405.     i_2 = icv2w1 + node2 - 1;
  1406.     q_1.r = cvalue[i_1].r - cvalue[i_2].r, q_1.i = cvalue[i_1].i - cvalue[
  1407.         i_2].i;
  1408.     be2w.r = q_1.r, be2w.i = q_1.i;
  1409. /*<       if (kdisto.eq.3) go to 550 >*/
  1410.     if (kdisto == 3) {
  1411.         goto L550;
  1412.     }
  1413. /*<       bew2=cvalue(icvw2+node3)-cvalue(icvw2+node2) >*/
  1414.     i_1 = icvw2 + node3 - 1;
  1415.     i_2 = icvw2 + node2 - 1;
  1416.     q_1.r = cvalue[i_1].r - cvalue[i_2].r, q_1.i = cvalue[i_1].i - cvalue[
  1417.         i_2].i;
  1418.     bew2.r = q_1.r, bew2.i = q_1.i;
  1419. /*<       if (kdisto.eq.5) go to 560 >*/
  1420.     if (kdisto == 5) {
  1421.         goto L560;
  1422.     }
  1423. /*<       if (kdisto.eq.6) go to 570 >*/
  1424.     if (kdisto == 6) {
  1425.         goto L570;
  1426.     }
  1427. /*<       bew12=cvalue(icvw12+node3)-cvalue(icvw12+node2) >*/
  1428.     i_1 = icvw12 + node3 - 1;
  1429.     i_2 = icvw12 + node2 - 1;
  1430.     q_1.r = cvalue[i_1].r - cvalue[i_2].r, q_1.i = cvalue[i_1].i - cvalue[
  1431.         i_2].i;
  1432.     bew12.r = q_1.r, bew12.i = q_1.i;
  1433. /*<       go to 580 >*/
  1434.     goto L580;
  1435.  
  1436. /*    calculate hd2 current generators */
  1437.  
  1438. /*<   540 difvn1=0.5d0*bew*bew >*/
  1439. L540:
  1440.     z_2.r = bew.r * .5, z_2.i = bew.i * .5;
  1441.     z_1.r = z_2.r * bew.r - z_2.i * bew.i, z_1.i = z_2.r * bew.i + z_2.i *
  1442.          bew.r;
  1443.     difvn1.r = z_1.r, difvn1.i = z_1.i;
  1444. /*<       go to 590 >*/
  1445.     goto L590;
  1446.  
  1447. /*    calculate hd3 current generators */
  1448.  
  1449. /*<   550 difvi1=0.5d0*bew*be2w >*/
  1450. L550:
  1451.     z_2.r = bew.r * .5, z_2.i = bew.i * .5;
  1452.     z_1.r = z_2.r * be2w.r - z_2.i * be2w.i, z_1.i = z_2.r * be2w.i + 
  1453.         z_2.i * be2w.r;
  1454.     difvi1.r = z_1.r, difvi1.i = z_1.i;
  1455. /*<       difvn1=0.25d0*bew*bew*bew >*/
  1456.     z_3.r = bew.r * .25, z_3.i = bew.i * .25;
  1457.     z_2.r = z_3.r * bew.r - z_3.i * bew.i, z_2.i = z_3.r * bew.i + z_3.i *
  1458.          bew.r;
  1459.     z_1.r = z_2.r * bew.r - z_2.i * bew.i, z_1.i = z_2.r * bew.i + z_2.i *
  1460.          bew.r;
  1461.     difvn1.r = z_1.r, difvn1.i = z_1.i;
  1462. /*<       go to 600 >*/
  1463.     goto L600;
  1464.  
  1465. /*    calculate im2d current generators */
  1466.  
  1467. /*<   560 difvn1=bew*conjg(bew2) >*/
  1468. L560:
  1469.     r_cnjg(&q_2, &bew2);
  1470.     q_1.r = bew.r * q_2.r - bew.i * q_2.i, q_1.i = bew.r * q_2.i + bew.i *
  1471.          q_2.r;
  1472.     difvn1.r = q_1.r, difvn1.i = q_1.i;
  1473. /*<       go to 590 >*/
  1474.     goto L590;
  1475.  
  1476. /*    calculate im2s current generators */
  1477.  
  1478. /*<   570 difvn1=bew*bew2 >*/
  1479. L570:
  1480.     q_1.r = bew.r * bew2.r - bew.i * bew2.i, q_1.i = bew.r * bew2.i + 
  1481.         bew.i * bew2.r;
  1482.     difvn1.r = q_1.r, difvn1.i = q_1.i;
  1483. /*<       go to 590 >*/
  1484.     goto L590;
  1485.  
  1486. /*    calculate im3 current generators */
  1487.  
  1488. /*<   580 difvi1=0.5d0*(be2w*conjg(bew2)+bew*bew12) >*/
  1489. L580:
  1490.     r_cnjg(&q_3, &bew2);
  1491.     q_2.r = be2w.r * q_3.r - be2w.i * q_3.i, q_2.i = be2w.r * q_3.i + 
  1492.         be2w.i * q_3.r;
  1493.     q_4.r = bew.r * bew12.r - bew.i * bew12.i, q_4.i = bew.r * bew12.i + 
  1494.         bew.i * bew12.r;
  1495.     q_1.r = q_2.r + q_4.r, q_1.i = q_2.i + q_4.i;
  1496.     z_1.r = q_1.r * .5, z_1.i = q_1.i * .5;
  1497.     difvi1.r = z_1.r, difvi1.i = z_1.i;
  1498. /*<       difvn1=bew*bew*conjg(bew2)*0.75d0 >*/
  1499.     q_2.r = bew.r * bew.r - bew.i * bew.i, q_2.i = bew.r * bew.i + bew.i *
  1500.          bew.r;
  1501.     r_cnjg(&q_3, &bew2);
  1502.     q_1.r = q_2.r * q_3.r - q_2.i * q_3.i, q_1.i = q_2.r * q_3.i + q_2.i *
  1503.          q_3.r;
  1504.     z_1.r = q_1.r * .75, z_1.i = q_1.i * .75;
  1505.     difvn1.r = z_1.r, difvn1.i = z_1.i;
  1506. /*<       go to 600 >*/
  1507.     goto L600;
  1508. /*<   590 dsg2=geq2*difvn1 >*/
  1509. L590:
  1510.     z_1.r = geq2 * difvn1.r, z_1.i = geq2 * difvn1.i;
  1511.     dsg2.r = z_1.r, dsg2.i = z_1.i;
  1512. /*<       dscdb1=0.5d0*cdb1*omega*cmplx(-aimag(difvn1),real(difvn1)) >*/
  1513.     d_1 = cdb1 * .5 * status_1.omega;
  1514.     d_2 = -(doublereal)r_imag(&difvn1);
  1515.     d_3 = difvn1.r;
  1516.     q_1.r = d_2, q_1.i = d_3;
  1517.     z_1.r = d_1 * q_1.r, z_1.i = d_1 * q_1.i;
  1518.     dscdb1.r = z_1.r, dscdb1.i = z_1.i;
  1519. /*<       dscdj1=0.5d0*cdj1*omega*cmplx(-aimag(difvn1),real(difvn1)) >*/
  1520.     d_1 = cdj1 * .5 * status_1.omega;
  1521.     d_2 = -(doublereal)r_imag(&difvn1);
  1522.     d_3 = difvn1.r;
  1523.     q_1.r = d_2, q_1.i = d_3;
  1524.     z_1.r = d_1 * q_1.r, z_1.i = d_1 * q_1.i;
  1525.     dscdj1.r = z_1.r, dscdj1.i = z_1.i;
  1526. /*<       go to 610 >*/
  1527.     goto L610;
  1528.  
  1529. /*<   600 dsg2=2.0d0*geq2*difvi1+geq3*difvn1 >*/
  1530. L600:
  1531.     d_1 = geq2 * 2.;
  1532.     z_2.r = d_1 * difvi1.r, z_2.i = d_1 * difvi1.i;
  1533.     z_3.r = geq3 * difvn1.r, z_3.i = geq3 * difvn1.i;
  1534.     z_1.r = z_2.r + z_3.r, z_1.i = z_2.i + z_3.i;
  1535.     dsg2.r = z_1.r, dsg2.i = z_1.i;
  1536. /*<       dscdb1=omega*(cdb1*difvi1+cdb2*difvn1/3.0d0) >*/
  1537.     z_3.r = cdb1 * difvi1.r, z_3.i = cdb1 * difvi1.i;
  1538.     z_5.r = cdb2 * difvn1.r, z_5.i = cdb2 * difvn1.i;
  1539.     z_4.r = z_5.r / 3., z_4.i = z_5.i / 3.;
  1540.     z_2.r = z_3.r + z_4.r, z_2.i = z_3.i + z_4.i;
  1541.     z_1.r = status_1.omega * z_2.r, z_1.i = status_1.omega * z_2.i;
  1542.     dscdb1.r = z_1.r, dscdb1.i = z_1.i;
  1543. /*<       dscdb1=cmplx(-aimag(dscdb1),real(dscdb1)) >*/
  1544.     d_1 = -(doublereal)r_imag(&dscdb1);
  1545.     d_2 = dscdb1.r;
  1546.     q_1.r = d_1, q_1.i = d_2;
  1547.     dscdb1.r = q_1.r, dscdb1.i = q_1.i;
  1548. /*<       dscdj1=omega*(cdj1*difvi1+cdj2*difvn1/3.0d0) >*/
  1549.     z_3.r = cdj1 * difvi1.r, z_3.i = cdj1 * difvi1.i;
  1550.     z_5.r = cdj2 * difvn1.r, z_5.i = cdj2 * difvn1.i;
  1551.     z_4.r = z_5.r / 3., z_4.i = z_5.i / 3.;
  1552.     z_2.r = z_3.r + z_4.r, z_2.i = z_3.i + z_4.i;
  1553.     z_1.r = status_1.omega * z_2.r, z_1.i = status_1.omega * z_2.i;
  1554.     dscdj1.r = z_1.r, dscdj1.i = z_1.i;
  1555. /*<       dscdj1=cmplx(-aimag(dscdj1),real(dscdj1)) >*/
  1556.     d_1 = -(doublereal)r_imag(&dscdj1);
  1557.     d_2 = dscdj1.r;
  1558.     q_1.r = d_1, q_1.i = d_2;
  1559.     dscdj1.r = q_1.r, dscdj1.i = q_1.i;
  1560.  
  1561. /*  determine contribution of each distortion source */
  1562.  
  1563. /*<   610 cvabe=cvalue(icvadj+node3)-cvalue(icvadj+node2) >*/
  1564. L610:
  1565.     i_1 = icvadj + node3 - 1;
  1566.     i_2 = icvadj + node2 - 1;
  1567.     q_1.r = cvalue[i_1].r - cvalue[i_2].r, q_1.i = cvalue[i_1].i - cvalue[
  1568.         i_2].i;
  1569.     cvabe.r = q_1.r, cvabe.i = q_1.i;
  1570. /*<       disto1=dsg2+dscdb1+dscdj1 >*/
  1571.     q_2.r = dsg2.r + dscdb1.r, q_2.i = dsg2.i + dscdb1.i;
  1572.     q_1.r = q_2.r + dscdj1.r, q_1.i = q_2.i + dscdj1.i;
  1573.     disto1.r = q_1.r, disto1.i = q_1.i;
  1574. /*<       cvdo(1)=dsg2*cvabe*arg >*/
  1575.     q_1.r = dsg2.r * cvabe.r - dsg2.i * cvabe.i, q_1.i = dsg2.r * cvabe.i 
  1576.         + dsg2.i * cvabe.r;
  1577.     z_1.r = arg * q_1.r, z_1.i = arg * q_1.i;
  1578.     cvdo[0].r = z_1.r, cvdo[0].i = z_1.i;
  1579. /*<       cvdo(2)=dscdb1*cvabe*arg >*/
  1580.     q_1.r = dscdb1.r * cvabe.r - dscdb1.i * cvabe.i, q_1.i = dscdb1.r * 
  1581.         cvabe.i + dscdb1.i * cvabe.r;
  1582.     z_1.r = arg * q_1.r, z_1.i = arg * q_1.i;
  1583.     cvdo[1].r = z_1.r, cvdo[1].i = z_1.i;
  1584. /*<       cvdo(3)=dscdj1*cvabe*arg >*/
  1585.     q_1.r = dscdj1.r * cvabe.r - dscdj1.i * cvabe.i, q_1.i = dscdj1.r * 
  1586.         cvabe.i + dscdj1.i * cvabe.r;
  1587.     z_1.r = arg * q_1.r, z_1.i = arg * q_1.i;
  1588.     cvdo[2].r = z_1.r, cvdo[2].i = z_1.i;
  1589. /*<       cvdo(4)=cvdo(1)+cvdo(2)+cvdo(3) >*/
  1590.     q_2.r = cvdo[0].r + cvdo[1].r, q_2.i = cvdo[0].i + cvdo[1].i;
  1591.     q_1.r = q_2.r + cvdo[2].r, q_1.i = q_2.i + cvdo[2].i;
  1592.     cvdo[3].r = q_1.r, cvdo[3].i = q_1.i;
  1593. /*<       cvdist=cvdist+cvdo(4) >*/
  1594.     q_1.r = cvdist.r + cvdo[3].r, q_1.i = cvdist.i + cvdo[3].i;
  1595.     cvdist.r = q_1.r, cvdist.i = q_1.i;
  1596. /*<       if (iprnt.eq.0) go to 680 >*/
  1597.     if (iprnt == 0) {
  1598.         goto L680;
  1599.     }
  1600. /*<       do 670 j=1,4 >*/
  1601.     for (j = 1; j <= 4; ++j) {
  1602. /*<       call magphs(cvdo(j),xmag,xphs) >*/
  1603.         magphs_(&cvdo[j - 1], &xmag, &xphs);
  1604. /*<       cvdo(j)=cmplx(sngl(xmag),sngl(xphs)) >*/
  1605.         i_1 = j - 1;
  1606.         d_1 = xmag;
  1607.         d_2 = xphs;
  1608.         q_1.r = d_1, q_1.i = d_2;
  1609.         cvdo[i_1].r = q_1.r, cvdo[i_1].i = q_1.i;
  1610. /*<   670 continue >*/
  1611. /* L670: */
  1612.     }
  1613. /*<       if (ititle.eq.0) write (iofile,501) >*/
  1614.     if (ititle == 0) {
  1615.         io__114.ciunit = status_1.iofile;
  1616.         s_wsfe(&io__114);
  1617.         e_wsfe();
  1618.     }
  1619. /*<       ititle=1 >*/
  1620.     ititle = 1;
  1621. /*<       write (iofile,446) value(locv),(vdo(1,j),j=1,4) >*/
  1622.     io__115.ciunit = status_1.iofile;
  1623.     s_wsfe(&io__115);
  1624.     do_fio(&c__1, (char *)&blank_1.value[locv - 1], (ftnlen)sizeof(
  1625.         doublereal));
  1626.     for (j = 1; j <= 4; ++j) {
  1627.         do_fio(&c__1, (char *)&vdo[(j << 1) - 2], (ftnlen)sizeof(real));
  1628.     }
  1629.     e_wsfe();
  1630. /*<       write (iofile,447) (vdo(2,j),j=1,4) >*/
  1631.     io__116.ciunit = status_1.iofile;
  1632.     s_wsfe(&io__116);
  1633.     for (j = 1; j <= 4; ++j) {
  1634.         do_fio(&c__1, (char *)&vdo[(j << 1) - 1], (ftnlen)sizeof(real));
  1635.     }
  1636.     e_wsfe();
  1637. /*<   680 value(lvn+node2)=value(lvn+node2)+real(disto1) >*/
  1638. L680:
  1639.     blank_1.value[tabinf_1.lvn + node2 - 1] += disto1.r;
  1640. /*<       value(lvn+node3)=value(lvn+node3)-real(disto1) >*/
  1641.     blank_1.value[tabinf_1.lvn + node3 - 1] -= disto1.r;
  1642. /*<       value(imvn+node2)=value(imvn+node2)+aimag(disto1) >*/
  1643.     blank_1.value[tabinf_1.imvn + node2 - 1] += r_imag(&disto1);
  1644. /*<       value(imvn+node3)=value(imvn+node3)-aimag(disto1) >*/
  1645.     blank_1.value[tabinf_1.imvn + node3 - 1] -= r_imag(&disto1);
  1646. /*<       loc=nodplc(loc) >*/
  1647.     loc = nodplc[loc - 1];
  1648. /*<       go to 520 >*/
  1649.     goto L520;
  1650.  
  1651. /*  obtain total distortion solution if necessary */
  1652.  
  1653. /*<   700 go to (1000,710,790,710,710,840,860),kdisto >*/
  1654. L700:
  1655.     switch (kdisto) {
  1656.         case 1:  goto L1000;
  1657.         case 2:  goto L710;
  1658.         case 3:  goto L790;
  1659.         case 4:  goto L710;
  1660.         case 5:  goto L710;
  1661.         case 6:  goto L840;
  1662.         case 7:  goto L860;
  1663.     }
  1664. /*<   710 call acsol >*/
  1665. L710:
  1666.     acsol_();
  1667.  
  1668. /*  store solution, print and store answers */
  1669.  
  1670. /*<   760 go to (1000,770,790,800,820,840,860),kdisto >*/
  1671. /* L760: */
  1672.     switch (kdisto) {
  1673.         case 1:  goto L1000;
  1674.         case 2:  goto L770;
  1675.         case 3:  goto L790;
  1676.         case 4:  goto L800;
  1677.         case 5:  goto L820;
  1678.         case 6:  goto L840;
  1679.         case 7:  goto L860;
  1680.     }
  1681. /*<   770 call copy16(cvalue(lcvn+1),cvalue(icv2w1+1),nstop) >*/
  1682. L770:
  1683.     copy16_(&cvalue[tabinf_1.lcvn], &cvalue[icv2w1], &cirdat_1.nstop);
  1684. /*<       call magphs(cvdist,o2mag,o2phs) >*/
  1685.     magphs_(&cvdist, &o2mag, &o2phs);
  1686. /*<       if (iprnt.eq.0) go to 900 >*/
  1687.     if (iprnt == 0) {
  1688.         goto L900;
  1689.     }
  1690. /*<       o2log=20.0d0*dlog10(o2mag) >*/
  1691.     o2log = d_lg10(&o2mag) * 20.;
  1692. /*<       write (iofile,781) o2mag,o2phs,o2log >*/
  1693.     io__120.ciunit = status_1.iofile;
  1694.     s_wsfe(&io__120);
  1695.     do_fio(&c__1, (char *)&o2mag, (ftnlen)sizeof(doublereal));
  1696.     do_fio(&c__1, (char *)&o2phs, (ftnlen)sizeof(doublereal));
  1697.     do_fio(&c__1, (char *)&o2log, (ftnlen)sizeof(doublereal));
  1698.     e_wsfe();
  1699. /*<   781 format (///5x,'hd2     magnitude  ',1pd10.3,5x,'phase  ',0pf7.2, >*/
  1700. /*<      1   5x,'=  ',f7.2,'  db') >*/
  1701. /*<       go to 900 >*/
  1702.     goto L900;
  1703. /*<   790 call magphs(cvdist,o3mag,o3phs) >*/
  1704. L790:
  1705.     magphs_(&cvdist, &o3mag, &o3phs);
  1706. /*<       if (iprnt.eq.0) go to 900 >*/
  1707.     if (iprnt == 0) {
  1708.         goto L900;
  1709.     }
  1710. /*<       o3log=20.0d0*dlog10(o3mag) >*/
  1711.     o3log = d_lg10(&o3mag) * 20.;
  1712. /*<       write (iofile,791) o3mag,o3phs,o3log >*/
  1713.     io__124.ciunit = status_1.iofile;
  1714.     s_wsfe(&io__124);
  1715.     do_fio(&c__1, (char *)&o3mag, (ftnlen)sizeof(doublereal));
  1716.     do_fio(&c__1, (char *)&o3phs, (ftnlen)sizeof(doublereal));
  1717.     do_fio(&c__1, (char *)&o3log, (ftnlen)sizeof(doublereal));
  1718.     e_wsfe();
  1719. /*<   791 format (///5x,'hd3     magnitude  ',1pd10.3,5x,'phase  ',0pf7.2, >*/
  1720. /*<      1   5x,'=  ',f7.2,'  db') >*/
  1721. /*<       go to 900 >*/
  1722.     goto L900;
  1723. /*<   800 call copy16(cvalue(lcvn+1),cvalue(icvw2+1),nstop) >*/
  1724. L800:
  1725.     copy16_(&cvalue[tabinf_1.lcvn], &cvalue[icvw2], &cirdat_1.nstop);
  1726. /*<       cvout=cvalue(icvw2+idnp)-cvalue(icvw2+idnn) >*/
  1727.     i_1 = icvw2 + idnp - 1;
  1728.     i_2 = icvw2 + idnn - 1;
  1729.     q_1.r = cvalue[i_1].r - cvalue[i_2].r, q_1.i = cvalue[i_1].i - cvalue[
  1730.         i_2].i;
  1731.     cvout.r = q_1.r, cvout.i = q_1.i;
  1732. /*<       call magphs(cvout,ow2mag,ow2phs) >*/
  1733.     magphs_(&cvout, &ow2mag, &ow2phs);
  1734. /*<       go to 1000 >*/
  1735.     goto L1000;
  1736. /*<   820 call copy16(cvalue(lcvn+1),cvalue(icvw12+1),nstop) >*/
  1737. L820:
  1738.     copy16_(&cvalue[tabinf_1.lcvn], &cvalue[icvw12], &cirdat_1.nstop);
  1739. /*<   840 call magphs(cvdist,o12mag,o12phs) >*/
  1740. L840:
  1741.     magphs_(&cvdist, &o12mag, &o12phs);
  1742. /*<       if (iprnt.eq.0) go to 900 >*/
  1743.     if (iprnt == 0) {
  1744.         goto L900;
  1745.     }
  1746. /*<       o12log=20.0d0*dlog10(o12mag) >*/
  1747.     o12log = d_lg10(&o12mag) * 20.;
  1748. /*<       if (kdisto.eq.6) go to 850 >*/
  1749.     if (kdisto == 6) {
  1750.         goto L850;
  1751.     }
  1752. /*<       write (iofile,841) o12mag,o12phs,o12log >*/
  1753.     io__128.ciunit = status_1.iofile;
  1754.     s_wsfe(&io__128);
  1755.     do_fio(&c__1, (char *)&o12mag, (ftnlen)sizeof(doublereal));
  1756.     do_fio(&c__1, (char *)&o12phs, (ftnlen)sizeof(doublereal));
  1757.     do_fio(&c__1, (char *)&o12log, (ftnlen)sizeof(doublereal));
  1758.     e_wsfe();
  1759. /*<   841 format (///5x,'im2d    magnitude  ',1pd10.3,5x,'phase  ',0pf7.2, >*/
  1760. /*<      1   5x,'=  ',f7.2,'  db') >*/
  1761. /*<       go to 900 >*/
  1762.     goto L900;
  1763. /*<   850 write (iofile,851) o12mag,o12phs,o12log >*/
  1764. L850:
  1765.     io__129.ciunit = status_1.iofile;
  1766.     s_wsfe(&io__129);
  1767.     do_fio(&c__1, (char *)&o12mag, (ftnlen)sizeof(doublereal));
  1768.     do_fio(&c__1, (char *)&o12phs, (ftnlen)sizeof(doublereal));
  1769.     do_fio(&c__1, (char *)&o12log, (ftnlen)sizeof(doublereal));
  1770.     e_wsfe();
  1771. /*<   851 format (///5x,'im2s    magnitude  ',1pd10.3,5x,'phase  ',0pf7.2, >*/
  1772. /*<      1   5x,'=  ',f7.2,'  db') >*/
  1773. /*<       go to 900 >*/
  1774.     goto L900;
  1775. /*<   860 call magphs(cvdist,o21mag,o21phs) >*/
  1776. L860:
  1777.     magphs_(&cvdist, &o21mag, &o21phs);
  1778. /*<       if (iprnt.eq.0) go to 900 >*/
  1779.     if (iprnt == 0) {
  1780.         goto L900;
  1781.     }
  1782. /*<       o21log=20.0d0*dlog10(o21mag) >*/
  1783.     o21log = d_lg10(&o21mag) * 20.;
  1784. /*<       write (iofile,861) o21mag,o21phs,o21log >*/
  1785.     io__133.ciunit = status_1.iofile;
  1786.     s_wsfe(&io__133);
  1787.     do_fio(&c__1, (char *)&o21mag, (ftnlen)sizeof(doublereal));
  1788.     do_fio(&c__1, (char *)&o21phs, (ftnlen)sizeof(doublereal));
  1789.     do_fio(&c__1, (char *)&o21log, (ftnlen)sizeof(doublereal));
  1790.     e_wsfe();
  1791. /*<   861 format (///5x,'im3     magnitude  ',1pd10.3,5x,'phase  ',0pf7.2, >*/
  1792. /*<      1   5x,'=  ',f7.2,'  db') >*/
  1793. /*<       cma=dabs(4.0d0*o21mag*dcos((o21phs-ophase)/rad)) >*/
  1794.     cma = (d_1 = o21mag * 4. * cos((o21phs - ophase) / knstnt_1.rad), abs(
  1795.         d_1));
  1796. /*<       cma=dmax1(cma,1.0d-20) >*/
  1797.     cma = max(cma,1e-20);
  1798. /*<       cmp=dabs(4.0d0*o21mag*dsin((o21phs-ophase)/rad)) >*/
  1799.     cmp = (d_1 = o21mag * 4. * sin((o21phs - ophase) / knstnt_1.rad), abs(
  1800.         d_1));
  1801. /*<       cmp=dmax1(cmp,1.0d-20) >*/
  1802.     cmp = max(cmp,1e-20);
  1803. /*<       cmalog=20.0d0*dlog10(cma) >*/
  1804.     cmalog = d_lg10(&cma) * 20.;
  1805. /*<       cmplog=20.0d0*dlog10(cmp) >*/
  1806.     cmplog = d_lg10(&cmp) * 20.;
  1807. /*<       write (iofile,866) >*/
  1808.     io__138.ciunit = status_1.iofile;
  1809.     s_wsfe(&io__138);
  1810.     e_wsfe();
  1811. /*<   866 format (////5x,'approximate cross modulation components') >*/
  1812. /*<       write (iofile,871) cma,cmalog >*/
  1813.     io__139.ciunit = status_1.iofile;
  1814.     s_wsfe(&io__139);
  1815.     do_fio(&c__1, (char *)&cma, (ftnlen)sizeof(doublereal));
  1816.     do_fio(&c__1, (char *)&cmalog, (ftnlen)sizeof(doublereal));
  1817.     e_wsfe();
  1818. /*<   871 format (/5x,'cma     magnitude  ',1pd10.3,24x,'=  ',0pf7.2,'  db') >*/
  1819. /*<       write (iofile,881) cmp,cmplog >*/
  1820.     io__140.ciunit = status_1.iofile;
  1821.     s_wsfe(&io__140);
  1822.     do_fio(&c__1, (char *)&cmp, (ftnlen)sizeof(doublereal));
  1823.     do_fio(&c__1, (char *)&cmplog, (ftnlen)sizeof(doublereal));
  1824.     e_wsfe();
  1825. /*<   881 format (/5x,'cmp     magnitude  ',1pd10.3,24x,'=  ',0pf7.2,'  db') >*/
  1826.  
  1827. /*  save distortion outputs */
  1828.  
  1829. /*<   900 iflag=kdisto+2 >*/
  1830. L900:
  1831.     iflag = kdisto + 2;
  1832. /*<       if (iflag.ge.7) iflag=iflag-1 >*/
  1833.     if (iflag >= 7) {
  1834.         --iflag;
  1835.     }
  1836. /*<       loc=locate(45) >*/
  1837.     loc = cirdat_1.locate[44];
  1838. /*<   910 if (loc.eq.0) go to 1000 >*/
  1839. L910:
  1840.     if (loc == 0) {
  1841.         goto L1000;
  1842.     }
  1843. /*<       if (nodplc(loc+5).ne.iflag) go to 920 >*/
  1844.     if (nodplc[loc + 4] != iflag) {
  1845.         goto L920;
  1846.     }
  1847. /*<       iseq=nodplc(loc+4) >*/
  1848.     tabinf_1.iseq = nodplc[loc + 3];
  1849. /*<       cvalue(loco+iseq)=cvdist >*/
  1850.     i_1 = *loco + tabinf_1.iseq - 1;
  1851.     cvalue[i_1].r = cvdist.r, cvalue[i_1].i = cvdist.i;
  1852. /*<   920 loc=nodplc(loc) >*/
  1853. L920:
  1854.     loc = nodplc[loc - 1];
  1855. /*<       go to 910 >*/
  1856.     goto L910;
  1857. /*<  1000 continue >*/
  1858. L1000:
  1859.     ;}
  1860.  
  1861. /*  finished */
  1862.  
  1863. /*<  2000 return >*/
  1864. /* L2000: */
  1865.     return 0;
  1866. /*<       end >*/
  1867. } /* disto_ */
  1868.  
  1869. #undef vdo
  1870. #undef cvalue
  1871. #undef nodplc
  1872. #undef cvdo
  1873. #undef distit
  1874.  
  1875.  
  1876.